
 { $I GLOBALS }
 (*$U-,S+*)

     (******************************************************************)
     (*                                                                *)
     (*  Copyright (c) 1978 Regents of the University of California.   *)
     (*  Permission to copy or distribute this software or documen-    *)
     (*  tation in hard or soft copy granted only by written license   *)
     (*  obtained from the Institute for Information Systems.          *)
     (*                                                                *)
     (******************************************************************)

 PROGRAM PASCALSYSTEM;

 (************************************************)
 (*                                              *)
 (*    UCSD PASCAL OPERATING SYSTEM              *)
 (*                                              *)
 (*    RELEASE LEVEL:  I.3   AUGUST, 1977        *)
 (*                      I.4   JANUARY, 1978     *)
 (*                    I.5   SEPTEMBER, 1978     *)
 (*                                              *)
 (*    WRITTEN BY ROGER T. SUMNER                *)
 (*    WINTER 1977                               *)
 (*                                              *)
 (*    INSTITUTE FOR INFORMATION SYSTEMS         *)
 (*    UC SAN DIEGO, LA JOLLA, CA                *)
 (*                                              *)
 (*    KENNETH L. BOWLES, DIRECTOR               *)
 (*                                              *)
 (************************************************)

 CONST
      MMAXINT = 32767;   (*MAXIMUM INTEGER VALUE*)
      MAXUNIT = 12;      (*MAXIMUM PHYSICAL UNIT # FOR UREAD*)
      MAXDIR = 77;       (*MAX NUMBER OF ENTRIES IN A DIRECTORY*)
      VIDLENG = 7;       (*NUMBER OF CHARS IN A VOLUME ID*)
      TIDLENG = 15;      (*NUMBER OF CHARS IN TITLE ID*)
      MAXSEG = 15;       (*MAX CODE SEGMENT NUMBER*)
      FBLKSIZE = 512;    (*STANDARD DISK BLOCK LENGTH*)
      DIRBLK = 2;        (*DISK ADDR OF DIRECTORY*)
      AGELIMIT = 300;    (*MAX AGE FOR GDIRP...IN TICKS*)
      EOL = 13;          (*END-OF-LINE...ASCII CR*)
      DLE = 16;          (*BLANK COMPRESSION CODE*)

 TYPE

      IORSLTWD = (INOERROR,IBADBLOCK,IBADUNIT,IBADMODE,ITIMEOUT,
                  ILOSTUNIT,ILOSTFILE,IBADTITLE,INOROOM,INOUNIT,
                  INOFILE,IDUPFILE,INOTCLOSED,INOTOPEN,IBADFORMAT,
                  ISTRGOVFL);

                                         (*COMMAND STATES...SEE GETCMD*)

      CMDSTATE = (HALTINIT,DEBUGCALL,
                  UPROGNOU,UPROGUOK,SYSPROG,
                  COMPONLY,COMPANDGO,COMPDEBUG,
                  LINKANDGO,LINKDEBUG);

                                         (*CODE FILES USED IN GETCMD*)

      SYSFILE = (ASSMBLER,COMPILER,EDITOR,FILER,LINKER);

                                         (*ARCHIVAL INFO...THE DATE*)

      DATEREC = PACKED RECORD
                  MONTH: 0..12;          (*0 IMPLIES DATE NOT MEANINGFUL*)
                  DAY: 0..31;            (*DAY OF MONTH*)
                  YEAR: 0..100           (*100 IS TEMP DISK FLAG*)
                END (*DATEREC*) ;

                                         (*VOLUME TABLES*)
      UNITNUM = 0..MAXUNIT;
      VID = STRING[VIDLENG];

                                         (*DISK DIRECTORIES*)
      DIRRANGE = 0..MAXDIR;
      TID = STRING[TIDLENG];

      FILEKIND = (UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,
                  INFOFILE,DATAFILE,GRAFFILE,FOTOFILE,SECUREDIR);

      DIRENTRY = RECORD
                   DFIRSTBLK: INTEGER;   (*FIRST PHYSICAL DISK ADDR*)
                   DLASTBLK: INTEGER;    (*POINTS AT BLOCK FOLLOWING*)
                   CASE DFKIND: FILEKIND OF
                     SECUREDIR,
                     UNTYPEDFILE: (*ONLY IN DIR[0]...VOLUME INFO*)
                        (DVID: VID;              (*NAME OF DISK VOLUME*)
                         DEOVBLK: INTEGER;       (*LASTBLK OF VOLUME*)
                         DNUMFILES: DIRRANGE;    (*NUM FILES IN DIR*)
                         DLOADTIME: INTEGER;     (*TIME OF LAST ACCESS*)
                         DLASTBOOT: DATEREC);    (*MOST RECENT DATE SETTING*)
                     XDSKFILE,CODEFILE,TEXTFILE,INFOFILE,
                     DATAFILE,GRAFFILE,FOTOFILE:
                        (DTID: TID;              (*TITLE OF FILE*)
                         DLASTBYTE: 1..FBLKSIZE; (*NUM BYTES IN LAST BLOCK*)
                         DACCESS: DATEREC)       (*LAST MODIFICATION DATE*)
                 END (*DIRENTRY*) ;

      DIRP = ^DIRECTORY;

      DIRECTORY = ARRAY [DIRRANGE] OF DIRENTRY;

                                         (*FILE INFORMATION*)

      CLOSETYPE = (CNORMAL,CLOCK,CPURGE,CCRUNCH);
      WINDOWP = ^WINDOW;
      WINDOW = PACKED ARRAY [0..0] OF CHAR;
      FIBP = ^FIB;

      FIB = RECORD
              FWINDOW: WINDOWP;  (*USER WINDOW...F^, USED BY GET-PUT*)
              FEOF,FEOLN: BOOLEAN;
              FSTATE: (FJANDW,FNEEDCHAR,FGOTCHAR);
              FRECSIZE: INTEGER; (*IN BYTES...0=>BLOCKFILE, 1=>CHARFILE*)
              CASE FISOPEN: BOOLEAN OF
                TRUE: (FISBLKD: BOOLEAN; (*FILE IS ON BLOCK DEVICE*)
                       FUNIT: UNITNUM;   (*PHYSICAL UNIT #*)
                       FVID: VID;        (*VOLUME NAME*)
                       FREPTCNT,         (* # TIMES F^ VALID W/O GET*)
                       FNXTBLK,          (*NEXT REL BLOCK TO IO*)
                       FMAXBLK: INTEGER; (*MAX REL BLOCK ACCESSED*)
                       FMODIFIED:BOOLEAN;(*PLEASE SET NEW DATE IN CLOSE*)
                       FHEADER: DIRENTRY;(*COPY OF DISK DIR ENTRY*)
                       CASE FSOFTBUF: BOOLEAN OF (*DISK GET-PUT STUFF*)
                         TRUE: (FNXTBYTE,FMAXBYTE: INTEGER;
                                FBUFCHNGD: BOOLEAN;
                                FBUFFER: PACKED ARRAY [0..FBLKSIZE] OF CHAR))
            END (*FIB*) ;

                                         (*USER WORKFILE STUFF*)

      INFOREC = RECORD
                  SYMFIBP,CODEFIBP: FIBP;        (*WORKFILES FOR SCRATCH*)
                  ERRSYM,ERRBLK,ERRNUM: INTEGER; (*ERROR STUFF IN EDIT*)
                  SLOWTERM,STUPID: BOOLEAN;      (*STUDENT PROGRAMMER ID!!*)
                  ALTMODE: CHAR;                 (*WASHOUT CHAR FOR COMPILER*)
                  GOTSYM,GOTCODE: BOOLEAN;       (*TITLES ARE MEANINGFUL*)
                  WORKVID,SYMVID,CODEVID: VID;   (*PERM&CUR WORKFILE VOLUMES*)
                  WORKTID,SYMTID,CODETID: TID    (*PERM&CUR WORKFILES TITLE*)
                END (*INFOREC*) ;

                                         (*CODE SEGMENT LAYOUTS*)

      SEGRANGE = 0..MAXSEG;
      SEGDESC = RECORD
                  DISKADDR: INTEGER;     (*REL BLK IN CODE...ABS IN SYSCOM^*)
                  CODELENG: INTEGER      (*# BYTES TO READ IN*)
                END (*SEGDESC*) ;

                                         (*DEBUGGER STUFF*)

      BYTERANGE = 0..255;
      TRICKARRAY = ARRAY [0..0] OF INTEGER; (* FOR MEMORY DIDDLING*)
      MSCWP = ^ MSCW;            (*MARK STACK RECORD POINTER*)
      MSCW = RECORD
               STATLINK: MSCWP;  (*POINTER TO PARENT MSCW*)
               DYNLINK: MSCWP;   (*POINTER TO CALLER'S MSCW*)
               MSSEG,MSJTAB: ^TRICKARRAY;
               MSIPC: INTEGER;
               LOCALDATA: TRICKARRAY
             END (*MSCW*) ;

                                         (*SYSTEM COMMUNICATION AREA*)
                                         (*SEE INTERPRETERS...NOTE  *)
                                         (*THAT WE ASSUME BACKWARD  *)
                                         (*FIELD ALLOCATION IS DONE *)

      SYSCOMREC = RECORD
                    IORSLT: IORSLTWD;    (*RESULT OF LAST IO CALL*)
                    XEQERR: INTEGER;     (*REASON FOR EXECERROR CALL*)
                    SYSUNIT: UNITNUM;    (*PHYSICAL UNIT OF BOOTLOAD*)
                    BUGSTATE: INTEGER;   (*DEBUGGER INFO*)
                    GDIRP: DIRP;         (*GLOBAL DIR POINTER,SEE VOLSEARCH*)
                    LASTMP,STKBASE,BOMBP: MSCWP;
                    MEMTOP,SEG,JTAB: INTEGER;
                    BOMBIPC: INTEGER;    (*WHERE XEQERR BLOWUP WAS*)
                    HLTLINE: INTEGER;    (*MORE DEBUGGER STUFF*)
                    BRKPTS: ARRAY [0..3] OF INTEGER;
                    RETRIES: INTEGER;    (*DRIVERS PUT RETRY COUNTS*)
                    EXPANSION: ARRAY [0..8] OF INTEGER;
                    HIGHTIME,LOWTIME: INTEGER;
                    MISCINFO: PACKED RECORD
                                NOBREAK,STUPID,SLOWTERM,
                                HASXYCRT,HASLCCRT,HAS8510A,HASCLOCK: BOOLEAN;
                                USERKIND:(NORMAL, AQUIZ, BOOKER, PQUIZ)
                              END;
                    CRTTYPE: INTEGER;
                    CRTCTRL: PACKED RECORD
                               RLF,NDFS,ERASEEOL,ERASEEOS,HOME,ESCAPE: CHAR;
                               BACKSPACE: CHAR;
                               FILLCOUNT: 0..255;
                               CLEARSCREEN, CLEARLINE: CHAR;
                               PREFIXED: PACKED ARRAY [0..8] OF BOOLEAN
                             END;
                    CRTINFO: PACKED RECORD
                               WIDTH,HEIGHT: INTEGER;
                               RIGHT,LEFT,DOWN,UP: CHAR;
                               BADCH,CHARDEL,STOP,BREAK,FLUSH,EOF: CHAR;
                               ALTMODE,LINEDEL: CHAR;
                               BACKSPACE,ETX,PREFIX: CHAR;
                               PREFIXED: PACKED ARRAY [0..13] OF BOOLEAN
                             END;
                    SEGTABLE: ARRAY [SEGRANGE] OF
                                RECORD
                                  CODEUNIT: UNITNUM;
                                  CODEDESC: SEGDESC
                                END
                  END (*SYSCOM*);

      MISCINFOREC = RECORD
                      MSYSCOM: SYSCOMREC
                    END;

 VAR
     SYSCOM: ^SYSCOMREC;                 (*MAGIC PARAM...SET UP IN BOOT*)
     GFILES: ARRAY [0..5] OF FIBP;       (*GLOBAL FILES, 0=INPUT, 1=OUTPUT*)
     USERINFO: INFOREC;                  (*WORK STUFF FOR COMPILER ETC*)
     EMPTYHEAP: ^INTEGER;                (*HEAP MARK FOR MEM MANAGING*)
     INPUTFIB,OUTPUTFIB,                 (*CONSOLE FILES...GFILES ARE COPIES*)
     SYSTERM,SWAPFIB: FIBP;              (*CONTROL AND SWAPSPACE FILES*)
     SYVID,DKVID: VID;                   (*SYSUNIT VOLID & DEFAULT VOLID*)
     THEDATE: DATEREC;                   (*TODAY...SET IN FILER OR SIGN ON*)
     DEBUGINFO: ^INTEGER;                (*DEBUGGERS GLOBAL INFO WHILE RUNIN*)
     STATE: CMDSTATE;                    (*FOR GETCOMMAND*)
     PL: STRING;                         (*PROMPTLINE STRING...SEE PROMPT*)
     IPOT: ARRAY [0..4] OF INTEGER;      (*INTEGER POWERS OF TEN*)
     FILLER: STRING[11];                 (*NULLS FOR CARRIAGE DELAY*)
     DIGITS: SET OF '0'..'9';
     UNITABLE: ARRAY [UNITNUM] OF (*0 NOT USED*)
                 RECORD
                   UVID: VID;    (*VOLUME ID FOR UNIT*)
                   CASE UISBLKD: BOOLEAN OF
                     TRUE: (UEOVBLK: INTEGER)
                 END (*UNITABLE*) ;
     FILENAME: ARRAY [SYSFILE] OF STRING[23];

 (*-------------------------------------------------------------------------*)
 (* SYSTEM PROCEDURE FORWARD DECLARATIONS *)
 (* THESE ARE ADDRESSED BY OBJECT CODE... *)
 (*  DO NOT MOVE WITHOUT CAREFUL THOUGHT  *)

 PROCEDURE EXECERROR;
   FORWARD;
 PROCEDURE FINIT(VAR F: FIB; WINDOW: WINDOWP; RECWORDS: INTEGER);
   FORWARD;
 PROCEDURE FRESET(VAR F: FIB);
   FORWARD;
 PROCEDURE FOPEN(VAR F: FIB; VAR FTITLE: STRING;
                 FOPENOLD: BOOLEAN; JUNK: FIBP);
   FORWARD;
 PROCEDURE FCLOSE(VAR F: FIB; FTYPE: CLOSETYPE);
   FORWARD;
 PROCEDURE FGET(VAR F: FIB);
   FORWARD;
 PROCEDURE FPUT(VAR F: FIB);
   FORWARD;
 PROCEDURE XSEEK;
   FORWARD;
 FUNCTION FEOF(VAR F: FIB): BOOLEAN;
   FORWARD;
 FUNCTION FEOLN(VAR F: FIB): BOOLEAN;
   FORWARD;
 PROCEDURE FREADINT(VAR F: FIB; VAR I: INTEGER);
   FORWARD;
 PROCEDURE FWRITEINT(VAR F: FIB; I,RLENG: INTEGER);
   FORWARD;
 PROCEDURE XREADREAL;
   FORWARD;
 PROCEDURE XWRITEREAL;
   FORWARD;
 PROCEDURE FREADCHAR(VAR F: FIB; VAR CH: CHAR);
   FORWARD;
 PROCEDURE FWRITECHAR(VAR F: FIB; CH: CHAR; RLENG: INTEGER);
   FORWARD;
 PROCEDURE FREADSTRING(VAR F: FIB; VAR S: STRING; SLENG: INTEGER);
   FORWARD;
 PROCEDURE FWRITESTRING(VAR F: FIB; VAR S: STRING; RLENG: INTEGER);
   FORWARD;
 PROCEDURE FWRITEBYTES(VAR F: FIB; VAR A: WINDOW; RLENG,ALENG: INTEGER);
   FORWARD;
 PROCEDURE FREADLN(VAR F: FIB);
   FORWARD;
 PROCEDURE FWRITELN(VAR F: FIB);
   FORWARD;
 PROCEDURE SCONCAT(VAR DEST,SRC: STRING; DESTLENG: INTEGER);
   FORWARD;
 PROCEDURE SINSERT(VAR SRC,DEST: STRING; DESTLENG,INSINX: INTEGER);
   FORWARD;
 PROCEDURE SCOPY(VAR SRC,DEST: STRING; SRCINX,COPYLENG: INTEGER);
   FORWARD;
 PROCEDURE SDELETE(VAR DEST: STRING; DELINX,DELLENG: INTEGER);
   FORWARD;
 FUNCTION SPOS(VAR TARGET,SRC: STRING): INTEGER;
   FORWARD;
 FUNCTION FBLOCKIO(VAR F: FIB; VAR A: WINDOW;
                   NBLOCKS,RBLOCK: INTEGER; DOREAD: BOOLEAN): INTEGER;
   FORWARD;
 PROCEDURE FGOTOXY(X,Y: INTEGER);
   FORWARD;

 (* NON FIXED FORWARD DECLARATIONS *)

 FUNCTION VOLSEARCH(VAR FVID: VID; LOOKHARD: BOOLEAN;
                    VAR FDIR: DIRP): UNITNUM;
   FORWARD;
 PROCEDURE WRITEDIR(FUNIT: UNITNUM; FDIR: DIRP);
   FORWARD;
 FUNCTION DIRSEARCH(VAR FTID: TID; FINDPERM: BOOLEAN; FDIR: DIRP): DIRRANGE;
   FORWARD;
 FUNCTION SCANTITLE(FTITLE: STRING; VAR FVID: VID; VAR FTID: TID;
                    VAR FSEGS: INTEGER; VAR FKIND: FILEKIND): BOOLEAN;
   FORWARD;
 PROCEDURE DELENTRY(FINX: DIRRANGE; FDIR: DIRP);
   FORWARD;
 PROCEDURE INSENTRY(VAR FENTRY: DIRENTRY; FINX: DIRRANGE; FDIR: DIRP);
   FORWARD;
 PROCEDURE HOMECURSOR;
   FORWARD;
 PROCEDURE CLEARSCREEN;
   FORWARD;
 PROCEDURE CLEARLINE;
   FORWARD;
 PROCEDURE PROMPT;
   FORWARD;
 FUNCTION SPACEWAIT(FLUSH: BOOLEAN): BOOLEAN;
   FORWARD;
 FUNCTION GETCHAR(FLUSH: BOOLEAN): CHAR;
   FORWARD;
 PROCEDURE COMMAND;
   FORWARD;
 { $I SYSSEGS  }

     (******************************************************************)
     (*                                                                *)
     (*  Copyright (c) 1978 Regents of the University of California.   *)
     (*  Permission to copy or distribute this software or documen-    *)
     (*  tation in hard or soft copy granted only by written license   *)
     (*  obtained from the Institute for Information Systems.          *)
     (*                                                                *)
     (******************************************************************)

 SEGMENT PROCEDURE USERPROGRAM(INPUT,OUTPUT: FIBP);
 BEGIN FWRITELN(SYSTERM^);
   PL := 'No user program';
   FWRITESTRING(SYSTERM^,PL,0)
 END (*USERPROGRAM*) ;

 SEGMENT PROCEDURE DEBUGGER;
 BEGIN FWRITELN(SYSTERM^);
   PL := 'No debugger in system';
   FWRITESTRING(SYSTERM^,PL,0)
 END (*DEBUGGER*) ;

 SEGMENT PROCEDURE PRINTERROR(XEQERR,IORSLT: INTEGER);
   VAR S: STRING[40];
 BEGIN S := 'Unknown run-time error';
   CASE XEQERR OF
     1:  S := 'Value range error';
     2:  S := 'No proc in seg-table';
     3:  S := 'Exit from uncalled proc';
     4:  S := 'Stack overflow';
     5:  S := 'Integer overflow';
     6:  S := 'Divide by zero';
     7:  S := 'NIL pointer reference';
     8:  S := 'Program interrupted by user';
     9:  S := 'System IO error';
    10:  BEGIN S := 'unknown cause';
           CASE IORSLT OF
             1:  S := 'parity (CRC)';
             2:  S := 'illegal unit #';
             3:  S := 'illegal IO request';
             4:  S := 'data-com timeout';
             5:  S := 'vol went off-line';
             6:  S := 'file lost in dir';
             7:  S := 'bad file name';
             8:  S := 'no room on vol';
             9:  S := 'vol not found';
            10:  S := 'file not found';
            11:  S := 'dup dir entry';
            12:  S := 'file already open';
            13:  S := 'file not open';
            14:  S := 'bad input format'
           END (*IO ERRORS*) ;
         INSERT('IO error: ',S,1)
       END;
    11:  S := 'Unimplemented instruction';
    12:  S := 'Floating point error';
    13:  S := 'String overflow';
    14:  S := 'Programmed HALT';
    15:  S := 'Programmed break-point'
   END (*XEQ ERRORS*) ;

   WRITELN(OUTPUT,S);
   WITH SYSCOM^.BOMBP^ DO
     WRITE(OUTPUT,'S# ',MSSEG^[0] MOD 256,
                  ', P# ',MSJTAB^[0] MOD 256,
                  ', I# ',MSIPC-(ORD(MSJTAB)-2-MSJTAB^[-1]))
 END (*PRINTERROR*) ;

 SEGMENT PROCEDURE INITIALIZE;
   VAR DOTRITON,JUSTBOOTED: BOOLEAN; LTITLE: STRING[40];
       MONTHS: ARRAY [0..15] OF STRING[3];
       DISPLAY: ARRAY [0..79,0..19] OF INTEGER; (*FOR TRITON*)
       STKFILL: ARRAY [0..1199] OF INTEGER;

   PROCEDURE INITSYSCOM;
     VAR TITLE: STRING;
         F: FILE OF MISCINFOREC;
     BEGIN
      (* FIRST SOME GLOBALS *)
         FILLER[0] := CHR(SYSCOM^.CRTCTRL.FILLCOUNT);
         FILLCHAR( FILLER[1], SYSCOM^.CRTCTRL.FILLCOUNT, CHR(0) );
       DEBUGINFO := NIL;
       IPOT[0] := 1; IPOT[1] := 10; IPOT[2] := 100;
       IPOT[3] := 1000; IPOT[4] := 10000; DIGITS := ['0'..'9'];
       WITH SYSCOM^ DO
         BEGIN
         XEQERR := 0;    IORSLT := INOERROR;
         BUGSTATE :=0
         END;
       TITLE := '*SYSTEM.MISCINFO' ;
       RESET( F, TITLE );
       IF IORESULT = ORD(INOERROR) THEN
         BEGIN
         IF NOT EOF( F ) THEN
           WITH SYSCOM^, F^ DO
             BEGIN
             MISCINFO := MSYSCOM.MISCINFO;
             CRTTYPE := MSYSCOM.CRTTYPE;
             CRTCTRL := MSYSCOM.CRTCTRL;
             CRTINFO := MSYSCOM.CRTINFO;
             FILLER[0] := CHR(SYSCOM^.CRTCTRL.FILLCOUNT);
             FILLCHAR( FILLER[1], SYSCOM^.CRTCTRL.FILLCOUNT, CHR(0) );
             END;
         CLOSE( F, NORMAL )
         END;
       UNITCLEAR(1) (*GIVE BIOS NEW SOFT CHARACTERS FOR CONSOLE*)
     END (*INITSYSCOM*) ;

   PROCEDURE INITUNITABLE;
     VAR LUNIT: UNITNUM; LDIR: DIRP;
   BEGIN
     FOR LUNIT := 0 TO MAXUNIT DO
       WITH UNITABLE[LUNIT] DO
         BEGIN UVID := '';
           UISBLKD := LUNIT IN [4,5,9..12];
           IF UISBLKD THEN UEOVBLK := MMAXINT;
           UNITCLEAR(LUNIT);
         END;
     UNITABLE[1].UVID := 'CONSOLE';
     UNITABLE[2].UVID := 'SYSTERM';
     SYVID := '';
     LUNIT := VOLSEARCH(SYVID,TRUE,LDIR);
     SYVID := UNITABLE[SYSCOM^.SYSUNIT].UVID;
     IF LENGTH(SYVID) = 0 THEN HALT;
     IF JUSTBOOTED THEN DKVID := SYVID;
     LUNIT := VOLSEARCH(SYVID,FALSE,LDIR);
     IF LDIR = NIL THEN HALT;
     THEDATE := LDIR^[0].DLASTBOOT;
     UNITCLEAR(6);
     IF IORESULT = ORD(INOERROR) THEN
       UNITABLE[6].UVID := 'PRINTER';
     UNITCLEAR(8);
     IF IORESULT = ORD(INOERROR) THEN
       UNITABLE[8].UVID := 'REMOTE';
   END (*INITUNITABLE*) ;

   PROCEDURE INITFNAMES;
     VAR F: SYSFILE;
         ALLOFEM, FOUND: SET OF SYSFILE;
         LUNIT: UNITNUM;
         LFIB: FIB;
   BEGIN
     FILENAME[ASSMBLER] := 'ASSMBLER';
     FILENAME[COMPILER] := 'COMPILER';
     FILENAME[EDITOR] := 'EDITOR';
     FILENAME[FILER] := 'FILER';
     FILENAME[LINKER] := 'LINKER';
     FINIT(LFIB, NIL,-1);
     FOUND := [];
     FOR F := ASSMBLER TO LINKER DO
       BEGIN
         INSERT(':SYSTEM.', FILENAME[F], 1);
         LTITLE := CONCAT(SYVID,FILENAME[F]);
         FOPEN(LFIB, LTITLE, TRUE, NIL);
         IF LFIB.FISOPEN THEN
           BEGIN
             FILENAME[F] := LTITLE;
             FOUND := FOUND + [F]
           END;
         FCLOSE(LFIB, CNORMAL)
       END;
     LUNIT := 1;
     ALLOFEM := [ASSMBLER,COMPILER,EDITOR,FILER,LINKER];
     WHILE FOUND <> ALLOFEM DO
       BEGIN
         WITH UNITABLE[LUNIT] DO
           IF UISBLKD THEN
             IF UVID <> '' THEN
               FOR F := ASSMBLER TO LINKER DO
                 IF NOT (F IN FOUND) THEN
                   BEGIN
                     LTITLE := CONCAT(UVID, FILENAME[F]);
                     FOPEN(LFIB,LTITLE,TRUE,NIL);

                     IF LFIB.FISOPEN THEN
                       BEGIN
                         FILENAME[F] := LTITLE;
                         FOUND := FOUND + [F]
                       END;
                     FCLOSE(LFIB, CNORMAL)
                   END;
         IF LUNIT = MAXUNIT THEN
           FOUND := ALLOFEM
         ELSE
           LUNIT := LUNIT+1
       END { WHILE }
   END (*INITFNAMES*) ;

   PROCEDURE INITCHARSET;
   TYPE CHARSET= ARRAY [32..127] OF
                   PACKED ARRAY [0..9] OF 0..255;
   VAR I: INTEGER;
       TRIX: RECORD CASE BOOLEAN OF
               TRUE:  (CHARADDR: INTEGER);
               FALSE: (CHARBUFP: ^ CHAR)
             END;
       CHARBUF: RECORD
                    SET1: CHARSET;
                    FILLER1: PACKED ARRAY [0..63] OF CHAR;
                    SET2: CHARSET;
                    FILLER2: PACKED ARRAY [0..63] OF CHAR;
                    TRITON: ARRAY [0..63,0..3] OF INTEGER
                  END (*CHARBUF*) ;
       LFIB: FIB;
   BEGIN FINIT(LFIB,NIL,-1);
     LTITLE := '*SYSTEM.CHARSET';
     FOPEN(LFIB,LTITLE,TRUE,NIL);
     IF LFIB.FISOPEN THEN
       BEGIN UNITWRITE(3,TRIX,128);
         IF IORESULT = ORD(INOERROR) THEN
           BEGIN
             WITH LFIB.FHEADER DO
               BEGIN DOTRITON := DLASTBLK-DFIRSTBLK > 4;
                 UNITREAD(LFIB.FUNIT,CHARBUF,SIZEOF(CHARBUF),DFIRSTBLK)
               END;
             TRIX.CHARADDR := 512-8192;  (*UNIBUS TRICKYNESS!*)
             FOR I := 32 TO 127 DO
               BEGIN
                 MOVERIGHT(CHARBUF.SET1[I],TRIX.CHARBUFP^,10);
                 TRIX.CHARADDR := TRIX.CHARADDR+16
               END;
             TRIX.CHARADDR := 512-6144;
             FOR I := 32 TO 127 DO
               BEGIN
                 MOVERIGHT(CHARBUF.SET2[I],TRIX.CHARBUFP^,10);
                 TRIX.CHARADDR := TRIX.CHARADDR+16
               END;
             UNITABLE[3].UVID := 'GRAPHIC';
             UNITWRITE(3,I,0)
           END
       END
     ELSE
       SYSCOM^.MISCINFO.HAS8510A := FALSE;
     IF DOTRITON THEN
       BEGIN (*INITIALIZE DISPLAY ARRAY*)
         FILLCHAR(DISPLAY,SIZEOF(DISPLAY),0);
         FOR I := 0 TO 63 DO
           MOVELEFT(CHARBUF.TRITON[I],DISPLAY[I,10],8)
       END;
     FCLOSE(LFIB,CNORMAL)
   END (*INITCHARSET*) ;

   PROCEDURE INITHEAP;
   VAR LWINDOW: WINDOWP;
   BEGIN (*BASIC FILE AND HEAP SETTUP*)
     SYSCOM^.GDIRP := NIL; (* MUST PRECEDE THE FIRST "NEW" EXECUTED *)
     NEW(SWAPFIB,TRUE,FALSE); FINIT(SWAPFIB^,NIL,-1);
     NEW(INPUTFIB,TRUE,FALSE);  NEW(LWINDOW);
     FINIT(INPUTFIB^,LWINDOW,0);
     NEW(OUTPUTFIB,TRUE,FALSE);  NEW(LWINDOW);
     FINIT(OUTPUTFIB^,LWINDOW,0);
     NEW(SYSTERM,TRUE,FALSE);  NEW(LWINDOW);
     FINIT(SYSTERM^,LWINDOW,0);
     GFILES[0] := INPUTFIB; GFILES[1] := OUTPUTFIB;
     WITH USERINFO DO
       BEGIN
         NEW(SYMFIBP,TRUE,FALSE); FINIT(SYMFIBP^,NIL,-1);
         NEW(CODEFIBP,TRUE,FALSE); FINIT(CODEFIBP^,NIL,-1)
       END;
     MARK(EMPTYHEAP)
   END (*INITHEAP*) ;

   PROCEDURE INITWORKFILE;
   BEGIN
     WITH USERINFO DO
       BEGIN (*INITIALIZE WORK FILES ETC*)
         ERRNUM := 0; ERRBLK := 0; ERRSYM := 0;
         IF JUSTBOOTED THEN
           BEGIN
             SYMTID := ''; CODETID := ''; WORKTID := '';
             SYMVID := SYVID; CODEVID := SYVID; WORKVID := SYVID
           END;
         IF LENGTH(SYMTID) > 0 THEN
           LTITLE := CONCAT(SYMVID,':',SYMTID)
         ELSE
           LTITLE := '*SYSTEM.WRK.TEXT';
         FOPEN(SYMFIBP^,LTITLE,TRUE,NIL);
         GOTSYM := SYMFIBP^.FISOPEN;
         IF GOTSYM THEN
           BEGIN SYMVID := SYMFIBP^.FVID;
             SYMTID := SYMFIBP^.FHEADER.DTID
           END;
         FCLOSE(SYMFIBP^,CNORMAL);
         IF LENGTH(CODETID) > 0 THEN
           LTITLE := CONCAT(CODEVID,':',CODETID)
         ELSE
           LTITLE := '*SYSTEM.WRK.CODE';
         FOPEN(CODEFIBP^,LTITLE,TRUE,NIL);
         GOTCODE := CODEFIBP^.FISOPEN;
         IF GOTCODE THEN
           BEGIN CODEVID := CODEFIBP^.FVID;
             CODETID := CODEFIBP^.FHEADER.DTID
           END;
         FCLOSE(CODEFIBP^,CNORMAL);
         ALTMODE := SYSCOM^.CRTINFO.ALTMODE;
         SLOWTERM := SYSCOM^.MISCINFO.SLOWTERM;
         STUPID := SYSCOM^.MISCINFO.STUPID
       END
   END (*INITWORKFILE*) ;

 PROCEDURE INITFILES;
   BEGIN
     FCLOSE(SWAPFIB^,CNORMAL);
     FCLOSE(USERINFO.SYMFIBP^,CNORMAL);
     FCLOSE(USERINFO.CODEFIBP^,CNORMAL);
     FCLOSE(INPUTFIB^,CNORMAL);
     FCLOSE(OUTPUTFIB^,CNORMAL);
     LTITLE := 'CONSOLE:';
     FOPEN(INPUTFIB^,LTITLE,TRUE,NIL);
     FOPEN(OUTPUTFIB^,LTITLE,TRUE,NIL);
     IF JUSTBOOTED THEN
       BEGIN LTITLE := 'SYSTERM:';
         FOPEN(SYSTERM^,LTITLE,TRUE,NIL)
       END;
     GFILES[0] := INPUTFIB;
     GFILES[1] := OUTPUTFIB;
     GFILES[2] := SYSTERM;
     GFILES[3] := NIL; GFILES[4] := NIL; GFILES[5] := NIL;
   END (*INITFILES*) ;

 BEGIN (*INITIALIZE*)
   JUSTBOOTED := EMPTYHEAP = NIL;
   DOTRITON := FALSE;
   MONTHS[ 0] := '???'; MONTHS[ 1] := 'Jan';
   MONTHS[ 2] := 'Feb'; MONTHS[ 3] := 'Mar';
   MONTHS[ 4] := 'Apr'; MONTHS[ 5] := 'May';
   MONTHS[ 6] := 'Jun'; MONTHS[ 7] := 'Jul';
   MONTHS[ 8] := 'Aug'; MONTHS[ 9] := 'Sep';
   MONTHS[10] := 'Oct'; MONTHS[11] := 'Nov';
   MONTHS[12] := 'Dec'; MONTHS[13] := '???';
   MONTHS[14] := '???'; MONTHS[15] := '???';
   IF JUSTBOOTED THEN INITHEAP
   ELSE RELEASE(EMPTYHEAP);
   INITUNITABLE; (*AND THEDATE*)
   INITFNAMES;
   INITFILES;
   INITWORKFILE;
   IF SYSCOM^.MISCINFO.HAS8510A THEN
     INITCHARSET;
   INITSYSCOM; (*AND SOME GLOBALS*)
   CLEARSCREEN; WRITELN(OUTPUT);
   IF JUSTBOOTED THEN
     BEGIN
       IF DOTRITON THEN
         BEGIN (*ASSUME DATA MEDIA SCREEN*)
           WRITE(OUTPUT,CHR(30),CHR(32),CHR(41));
           UNITWRITE(3,DISPLAY[-80],23)
         END;
       WRITELN(OUTPUT,'Welcome  ',SYVID,',  to');
       IF DOTRITON THEN WRITELN(OUTPUT);
       WRITELN(OUTPUT,'U.C.S.D.  Pascal  System  I.5');
       IF DOTRITON THEN WRITELN(OUTPUT);
       WITH THEDATE DO
         WRITE(OUTPUT,'Current date is  ',DAY,'-',MONTHS[MONTH],'-',YEAR)
     END
   ELSE
     WRITE(OUTPUT,'System re-initialized')
 END (*INITIALIZE*) ;

 SEGMENT FUNCTION GETCMD(LASTST: CMDSTATE): CMDSTATE;
   CONST ASSEMONLY = LINKANDGO;
   VAR CH: CHAR; BADCMD: BOOLEAN;

   PROCEDURE RUNWORKFILE(OKTOLINK, RUNONLY: BOOLEAN);
     FORWARD;

   FUNCTION ASSOCIATE(TITLE: STRING; OKTOLINK, RUNONLY: BOOLEAN): BOOLEAN;
     LABEL 1;
     VAR RSLT: IORSLTWD; LSEG: SEGRANGE;
         SEGTBL: RECORD
                   DISKINFO: ARRAY [SEGRANGE] OF SEGDESC;
                   SEGNAME: ARRAY [SEGRANGE] OF
                              PACKED ARRAY [0..7] OF CHAR;
                   SEGKIND: ARRAY [SEGRANGE] OF
                              (LINKED,HOSTSEG,SEGPROC,UNITSEG,SEPRTSEG);
                   FILLER: ARRAY [0..143] OF INTEGER
                 END { SEGTBL } ;
   BEGIN ASSOCIATE := FALSE;
     FOPEN(USERINFO.CODEFIBP^,TITLE,TRUE,NIL);
     RSLT := SYSCOM^.IORSLT;
     IF RSLT <> INOERROR THEN
       BEGIN
         IF TITLE <> '*SYSTEM.STARTUP' THEN
           IF RSLT = IBADTITLE THEN
             WRITE(OUTPUT,'Illegal file name')
           ELSE
             WRITE(OUTPUT,'No file ',TITLE);
         GOTO 1
       END;
     WITH USERINFO,SYSCOM^ DO
       IF CODEFIBP^.FHEADER.DFKIND <> CODEFILE THEN
         BEGIN
           WRITE(OUTPUT,TITLE,' not code');
           GOTO 1
         END
       ELSE
         BEGIN
           UNITREAD(CODEFIBP^.FUNIT,SEGTBL,SIZEOF(SEGTBL),
                         CODEFIBP^.FHEADER.DFIRSTBLK);
           IF IORESULT <> ORD(INOERROR) THEN
             BEGIN
               WRITE(OUTPUT,'Bad block #0');
               GOTO 1
             END;
           WITH SEGTBL DO
             FOR LSEG := 0 TO MAXSEG DO
               IF (SEGKIND[LSEG]<LINKED) OR (SEGKIND[LSEG]>SEPRTSEG) THEN
                 BEGIN { PRE I.5 CODE...FIX UP! }
                   FILLCHAR(SEGKIND, SIZEOF(SEGKIND), ORD(LINKED));
                   FILLCHAR(FILLER, SIZEOF(FILLER), 0);
                   UNITWRITE(CODEFIBP^.FUNIT, SEGTBL, SIZEOF(SEGTBL),
                                 CODEFIBP^.FHEADER.DFIRSTBLK)
                 END;
           WITH SEGTBL DO
             FOR LSEG := 0 TO MAXSEG DO
               IF SEGKIND[LSEG] <> LINKED THEN
               BEGIN
                 IF OKTOLINK THEN
                   BEGIN WRITELN(OUTPUT,'Linking...');
                     FCLOSE(CODEFIBP^, CNORMAL);
                     IF ASSOCIATE(FILENAME[LINKER], FALSE, FALSE) THEN
                       BEGIN
                         IF RUNONLY THEN GETCMD := LINKANDGO
                         ELSE GETCMD := LINKDEBUG;
                         EXIT(GETCMD)
                       END
                   END
                 ELSE
                   IF NOT (LASTST IN [LINKANDGO, LINKDEBUG]) THEN
                     WRITE(OUTPUT,'Must L(ink first');
                 GOTO 1
               END;
           FOR LSEG := 1 TO MAXSEG DO
             IF (LSEG = 1) OR (LSEG >= 7) THEN
               WITH SEGTABLE[LSEG],SEGTBL.DISKINFO[LSEG] DO
                 BEGIN CODEUNIT := CODEFIBP^.FUNIT;
                   CODEDESC.CODELENG := CODELENG;
                   CODEDESC.DISKADDR := DISKADDR+
                                         CODEFIBP^.FHEADER.DFIRSTBLK
                 END
         END;
     ASSOCIATE := TRUE;
 1:  FCLOSE(USERINFO.CODEFIBP^,CNORMAL)
   END (*ASSOCIATE*) ;

   PROCEDURE STARTCOMPILE(NEXTST: CMDSTATE);
     LABEL 1;
     VAR TITLE: STRING[40];
   BEGIN
     IF NEXTST = ASSEMONLY THEN
       WRITE(OUTPUT,'Assembling')
     ELSE
       WRITE(OUTPUT,'Compiling');
     WRITELN(OUTPUT,'...');

     IF NEXTST = ASSEMONLY THEN
       TITLE := FILENAME[ASSMBLER]
     ELSE
       TITLE := FILENAME[COMPILER];
     IF ASSOCIATE(TITLE, FALSE, FALSE) THEN
       WITH USERINFO DO
         BEGIN
             IF GOTSYM THEN
               TITLE := CONCAT(SYMVID,':',SYMTID)
             ELSE
               BEGIN
                 IF NEXTST = ASSEMONLY THEN
                   WRITE(OUTPUT, 'Assemble')
                 ELSE
                   WRITE(OUTPUT, 'Compile');
                 WRITE(OUTPUT,' what text? ');
                 READLN(INPUT, TITLE);
                 IF TITLE = '' THEN GOTO 1;
                 INSERT('.TEXT', TITLE, LENGTH(TITLE)+1);
                 GOTCODE := FALSE
               END;
             FOPEN(SYMFIBP^,TITLE,TRUE,NIL);
             IF IORESULT <> ORD(INOERROR) THEN
               BEGIN
                 WRITE(OUTPUT,'Can''t find ', TITLE);
                 GOTSYM := FALSE; GOTO 1
               END;
             TITLE := '*SYSTEM.SWAPDISK';
             FOPEN(SWAPFIB^,TITLE,TRUE,NIL);
             TITLE := '*SYSTEM.WRK.CODE[*]';
             FOPEN(CODEFIBP^,TITLE,FALSE,NIL);
             IF IORESULT <> ORD(INOERROR) THEN
               BEGIN
                 WRITE(OUTPUT,'Code open error!');
                 GOTO 1
               END;
             ERRNUM := 0; ERRBLK := 0; ERRSYM := 0;
             IF NEXTST = ASSEMONLY THEN
               NEXTST := COMPONLY;
             GETCMD := NEXTST; EXIT(GETCMD)
         END;
   1:
   END (*STARTCOMPILE*) ;

   PROCEDURE FINISHCOMPILE;
   BEGIN
     FCLOSE(USERINFO.SYMFIBP^,CNORMAL);
     FCLOSE(SWAPFIB^,CNORMAL);
     IF SYSCOM^.MISCINFO.HAS8510A THEN
       UNITCLEAR(3);
     WITH USERINFO DO
       IF ERRNUM > 0 THEN
         BEGIN GOTCODE := FALSE;
           FCLOSE(CODEFIBP^,CPURGE);
           IF ERRBLK > 0 THEN
             BEGIN CLEARSCREEN; WRITELN(OUTPUT);
               IF ASSOCIATE(FILENAME[EDITOR], FALSE, FALSE) THEN
                 BEGIN GETCMD := SYSPROG; EXIT(GETCMD) END
             END
         END
       ELSE
         BEGIN GOTCODE := TRUE;
           CODEVID := CODEFIBP^.FVID;
           CODETID := CODEFIBP^.FHEADER.DTID;
           FCLOSE(CODEFIBP^,CLOCK);
           IF LASTST IN [COMPANDGO,COMPDEBUG] THEN
             RUNWORKFILE(TRUE, LASTST = COMPANDGO)
         END
   END (*FINISHCOMPILE*) ;

   PROCEDURE EXECUTE;
     VAR TITLE: STRING[255];
   BEGIN
     WRITE(OUTPUT,'Execute');
     IF NOT SYSCOM^.MISCINFO.SLOWTERM THEN
       WRITE(OUTPUT,' what file');
     WRITE(OUTPUT,'? '); READLN(TITLE);
     IF LENGTH(TITLE) > 0 THEN
       BEGIN
         IF TITLE[LENGTH(TITLE)] = '.' THEN
           DELETE(TITLE,LENGTH(TITLE),1)
         ELSE
           INSERT('.CODE',TITLE,LENGTH(TITLE)+1);
         IF ASSOCIATE(TITLE, FALSE, FALSE) THEN
           BEGIN GETCMD := SYSPROG; EXIT(GETCMD) END
       END
   END (*EXECUTE*) ;

   PROCEDURE RUNWORKFILE;
   BEGIN
     WITH USERINFO DO
     IF GOTCODE THEN
       BEGIN CLEARSCREEN;
         IF ASSOCIATE(CONCAT(CODEVID,':',CODETID), OKTOLINK, RUNONLY) THEN
           BEGIN
             WRITELN(OUTPUT,'Running...');
             IF RUNONLY THEN
                 GETCMD := SYSPROG
             ELSE
                 GETCMD := DEBUGCALL;
             EXIT(GETCMD)
           END;
         IF NOT (LASTST IN [LINKANDGO, LINKDEBUG]) THEN
           GOTCODE := FALSE
       END
     ELSE
       IF RUNONLY THEN
         STARTCOMPILE(COMPANDGO)
       ELSE
         STARTCOMPILE(COMPDEBUG)
   END { RUNWORKFILE } ;

 BEGIN (*GETCMD*)
   FRESET(INPUTFIB^); FRESET(OUTPUTFIB^); FRESET(SYSTERM^);
   GFILES[0] := INPUTFIB; GFILES[1] := OUTPUTFIB;
   IF LASTST = HALTINIT THEN
     IF ASSOCIATE('*SYSTEM.STARTUP',FALSE,FALSE) THEN
       BEGIN CLEARSCREEN;
         WRITELN(OUTPUT,'Initializing...');
         GETCMD := SYSPROG; EXIT(GETCMD)
       END;
   IF LASTST IN [COMPONLY,COMPANDGO,COMPDEBUG] THEN
     FINISHCOMPILE;
   IF LASTST IN [LINKANDGO,LINKDEBUG] THEN
     RUNWORKFILE(FALSE, LASTST = LINKANDGO);
   IF SYSCOM^.MISCINFO.USERKIND = AQUIZ THEN
     IF LASTST = HALTINIT THEN
       BEGIN LASTST := COMPANDGO; RUNWORKFILE(TRUE, TRUE) END
     ELSE
       BEGIN
         EMPTYHEAP := NIL;
         GETCMD := HALTINIT;
         EXIT(GETCMD)
       END;
   WITH USERINFO DO
     BEGIN ERRNUM := 0; ERRBLK := 0; ERRSYM := 0 END;
   BADCMD := FALSE;
   REPEAT
     PL :=
 'Command: E(dit, R(un, F(ile, C(omp, L(ink, X(ecute, A(ssem, D(ebug,? [I.5e]';
     PROMPT; CH := GETCHAR(BADCMD); CLEARSCREEN;
     IF CH = '?' THEN
       BEGIN PL := 'Command: U(ser restart, I(nitialize, H(alt';
         PROMPT; CH := GETCHAR(BADCMD); CLEARSCREEN
       END;
     BADCMD := NOT (CH IN ['E','R','F','C','L','X','A','D','U','I','H','?']);
     IF NOT BADCMD THEN
       CASE CH OF
         'E':  BEGIN WRITELN(OUTPUT);
                 IF ASSOCIATE(FILENAME[EDITOR], FALSE, FALSE) THEN
                   BEGIN GETCMD := SYSPROG; EXIT(GETCMD) END
               END;
         'F':  BEGIN WRITELN(OUTPUT);
                 IF ASSOCIATE(FILENAME[FILER], FALSE, FALSE) THEN
                   BEGIN GETCMD := SYSPROG; EXIT(GETCMD) END
               END;
         'L':  BEGIN WRITELN(OUTPUT,'Linking...');
                 IF ASSOCIATE(FILENAME[LINKER], FALSE, FALSE) THEN
                   BEGIN GETCMD := SYSPROG; EXIT(GETCMD) END
               END;
         'X':  EXECUTE;
         'C':  STARTCOMPILE(COMPONLY);
         'A':  STARTCOMPILE(ASSEMONLY);
         'U':  IF LASTST <> UPROGNOU THEN
                 BEGIN
                   WRITELN(OUTPUT,'Restarting...');
                   GETCMD := SYSPROG; EXIT(GETCMD)
                 END
               ELSE
                 BEGIN WRITELN(OUTPUT); WRITE(OUTPUT,'U not allowed') END;
     'R','D':  RUNWORKFILE(TRUE, CH = 'R');
     'I','H':  BEGIN
                 GETCMD := HALTINIT;
                 IF CH = 'H' THEN
                   EMPTYHEAP := NIL;
                 EXIT(GETCMD)
               END
       END
   UNTIL FALSE
 END (*GETCMD*) ;
 { $I SYSTEM.B }

     (******************************************************************)
     (*                                                                *)
     (*  Copyright (c) 1978 Regents of the University of California.   *)
     (*  Permission to copy or distribute this software or documen-    *)
     (*  tation in hard or soft copy granted only by written license   *)
     (*  obtained from the Institute for Information Systems.          *)
     (*                                                                *)
     (******************************************************************)

 PROCEDURE EXECERROR;
 BEGIN
   WITH SYSCOM^ DO
     BEGIN
       IF XEQERR = 4 THEN
         BEGIN RELEASE(EMPTYHEAP);
           PL := '*STK OFLOW*';
           UNITWRITE(2,PL[1],LENGTH(PL));
           EXIT(COMMAND)
         END;
       BOMBP^.MSIPC := BOMBIPC;
       IF BUGSTATE <> 0 THEN
         BEGIN DEBUGGER; XEQERR := 0 END
       ELSE
         BEGIN RELEASE(EMPTYHEAP);
           GFILES[0] := INPUTFIB; GFILES[1] := OUTPUTFIB;
           BOMBIPC := IORESULT; FWRITELN(SYSTERM^);
           IF UNITABLE[SYSUNIT].UVID = SYVID THEN
             PRINTERROR(XEQERR,BOMBIPC)
           ELSE
             BEGIN
               WRITE(OUTPUT,'Exec err # ',XEQERR);
               IF XEQERR = 10 THEN
                 WRITE(OUTPUT,',',BOMBIPC)
             END;
           WRITELN(OUTPUT);
           IF NOT SPACEWAIT(TRUE) THEN EXIT(COMMAND)
         END
     END
 END (*EXECERROR*) ;

 FUNCTION CHECKDEL(CH: CHAR; VAR SINX: INTEGER): BOOLEAN;
 BEGIN CHECKDEL := FALSE;
   WITH SYSCOM^,CRTCTRL DO
     BEGIN
       IF CH = CRTINFO.LINEDEL THEN
         BEGIN CHECKDEL := TRUE;
           IF (BACKSPACE = CHR(0)) OR (ERASEEOL = CHR(0)) THEN
             BEGIN SINX := 1;
               WRITELN(OUTPUT,'<DEL')
             END
           ELSE
             BEGIN
               WHILE SINX > 1 DO
                 BEGIN SINX := SINX-1; WRITE(OUTPUT,BACKSPACE) END;
               WRITE(OUTPUT,ESCAPE,ERASEEOL)
             END
         END;
       IF CH = CRTINFO.CHARDEL THEN
         BEGIN CHECKDEL := TRUE;
           IF SINX > 1 THEN
             BEGIN SINX := SINX-1;
               IF BACKSPACE = CHR(0) THEN
                 IF CRTINFO.CHARDEL < ' ' THEN
                   WRITE(OUTPUT,'_')
                 ELSE (*ASSUME PRINTABLE*)
               ELSE
                 BEGIN
                   IF CRTINFO.CHARDEL <> BACKSPACE THEN
                     WRITE(OUTPUT,BACKSPACE);
                   WRITE(OUTPUT,' ',BACKSPACE)
                 END
             END
           ELSE
             IF CRTINFO.CHARDEL = BACKSPACE THEN
               WRITE(OUTPUT,' ')
         END
     END
 END (*CHECKDEL*) ;


 PROCEDURE PUTPREFIXED(WHICH:INTEGER; COMMANDCHAR:CHAR);
 BEGIN
   WITH SYSCOM^ DO
     IF COMMANDCHAR <> CHR(0) THEN
       BEGIN
         IF CRTCTRL.PREFIXED[WHICH] THEN
           WRITE(OUTPUT,CRTCTRL.ESCAPE);
         WRITE(OUTPUT,COMMANDCHAR);
         IF LENGTH(FILLER)>0 THEN
           WRITE(OUTPUT,FILLER);
       END;
 END;

 PROCEDURE HOMECURSOR;
 BEGIN
   PUTPREFIXED(4,SYSCOM^.CRTCTRL.HOME);
 END (*HOMECURSOR*) ;
	
 PROCEDURE CLEARSCREEN;
 BEGIN HOMECURSOR;
   WITH SYSCOM^,CRTCTRL DO
     BEGIN
       IF MISCINFO.HAS8510A THEN UNITCLEAR(3);
       IF ERASEEOS <> CHR(0) THEN
         PUTPREFIXED(3,ERASEEOS)
       ELSE
         PUTPREFIXED(6,CLEARSCREEN)
     END
 END (*CLEARSCREEN*) ;

 PROCEDURE CLEARLINE;
 BEGIN
   PUTPREFIXED(2,SYSCOM^.CRTCTRL.ERASEEOL)
 END (*CLEARLINE*) ;

 PROCEDURE PROMPT;
   VAR I: INTEGER;
 BEGIN HOMECURSOR;
   WITH SYSCOM^ DO
     BEGIN
       CLEARLINE;
       IF MISCINFO.SLOWTERM THEN
         BEGIN
           I := SCAN(LENGTH(PL),=':',PL[1]);
           IF I <> LENGTH(PL) THEN PL[0] := CHR(I+1)
         END
     END;
   WRITE(OUTPUT,PL)
 END (*PROMPT*) ;

 PROCEDURE FGOTOXY(*X,Y: INTEGER*);
 BEGIN (*ASSUME DATA MEDIA*)
   WITH SYSCOM^.CRTINFO DO
     BEGIN
       IF X < 0 THEN X := 0;
       IF X > WIDTH THEN X := WIDTH;
       IF Y < 0 THEN Y := 0;
       IF Y > HEIGHT THEN Y := HEIGHT
     END;
   WRITE(OUTPUT,CHR(30),CHR(X+32),CHR(Y+32))
 END (*GOTOXY*) ;

 FUNCTION GETCHAR(*FLUSH: BOOLEAN*);
   VAR CH: CHAR;
 BEGIN
   IF FLUSH THEN UNITCLEAR(1);
   IF INPUTFIB^.FEOF THEN EXIT(COMMAND);
   INPUTFIB^.FSTATE := FNEEDCHAR;
   READ(INPUT,CH);
   IF (CH >= 'a') AND (CH <= 'z') THEN
     CH := CHR(ORD(CH)-ORD('a')+ORD('A'));
   GETCHAR := CH
 END (*GETCHAR*) ;

 FUNCTION SPACEWAIT(*FLUSH: BOOLEAN*);
   VAR CH: CHAR;
 BEGIN
   REPEAT
     WRITE(OUTPUT,'Type <space>');
     IF NOT SYSCOM^.MISCINFO.SLOWTERM THEN
       WRITE(OUTPUT,' to continue');
     CH := GETCHAR(FLUSH);
     IF NOT EOLN(INPUT) THEN
       WRITELN(OUTPUT);
     CLEARLINE
   UNTIL (CH = ' ') OR (CH = SYSCOM^.CRTINFO.ALTMODE);
   SPACEWAIT := CH <> ' '
 END (*SPACEWAIT*) ;

 FUNCTION SCANTITLE(*FTITLE: STRING; VAR FVID: VID; VAR FTID: TID;
                     VAR FSEGS: INTEGER; VAR FKIND: FILEKIND*);
   VAR I,RBRACK: INTEGER; CH: CHAR; OK: BOOLEAN;
 BEGIN
   FVID := ''; FTID := '';
   FSEGS := 0; FKIND := UNTYPEDFILE;
   SCANTITLE := FALSE; I := 1;
   WHILE I <= LENGTH(FTITLE) DO
     BEGIN CH := FTITLE[I];
       IF CH <= ' ' THEN DELETE(FTITLE,I,1)
       ELSE
         BEGIN
           IF (CH >= 'a') AND (CH <= 'z') THEN
             FTITLE[I] := CHR(ORD(CH)-ORD('a')+ORD('A'));
           I := I+1
         END
     END;
   IF LENGTH(FTITLE) > 0 THEN
     BEGIN
       IF FTITLE[1] = '*' THEN
         BEGIN FVID := SYVID; DELETE(FTITLE,1,1) END;
       I := POS(':',FTITLE);
       IF I <= 1 THEN
         BEGIN
           IF LENGTH(FVID) = 0 THEN FVID := DKVID;
           IF I = 1 THEN DELETE(FTITLE,1,1)
         END
       ELSE
         IF I-1 <= VIDLENG THEN
           BEGIN
             FVID := COPY(FTITLE,1,I-1);
             DELETE(FTITLE,1,I)
           END;
       IF LENGTH(FVID) > 0 THEN
         BEGIN
           I := POS('[',FTITLE);
           IF I > 0 THEN I := I-1
           ELSE I := LENGTH(FTITLE);
           IF I <= TIDLENG THEN
             BEGIN
               IF I > 0 THEN
                 BEGIN FTID := COPY(FTITLE,1,I); DELETE(FTITLE,1,I) END;
               IF LENGTH(FTITLE) = 0 THEN OK := TRUE
               ELSE
                 BEGIN OK := FALSE;
                   RBRACK := POS(']',FTITLE);
                   IF RBRACK = 2 THEN OK := TRUE
                   ELSE
                     IF RBRACK > 2 THEN
                       BEGIN OK := TRUE; I := 2;
                         REPEAT CH := FTITLE[I];
                           IF CH IN DIGITS THEN
                             FSEGS := FSEGS*10+(ORD(CH)-ORD('0'))
                           ELSE OK := FALSE;
                           I := I+1
                         UNTIL (I = RBRACK) OR NOT OK;
                         IF (I = 3) AND (RBRACK = 3) THEN
                           IF FTITLE[I-1] = '*' THEN
                             BEGIN FSEGS := -1; OK := TRUE END
                       END
                 END;
               SCANTITLE := OK;
               IF OK AND (LENGTH(FTID) > 5) THEN
                 BEGIN
                   FTITLE := COPY(FTID,LENGTH(FTID)-4,5);
                   IF FTITLE = '.TEXT' THEN FKIND := TEXTFILE
                   ELSE
                   IF FTITLE = '.CODE' THEN FKIND := CODEFILE
                   ELSE
                   IF FTITLE = '.INFO' THEN FKIND := INFOFILE
                   ELSE
                   IF FTITLE = '.GRAF' THEN FKIND := GRAFFILE
                   ELSE
                   IF FTITLE = '.FOTO' THEN FKIND := FOTOFILE
                 END
             END
         END
     END
 END (*SCANTITLE*) ;

 (* VOLUME AND DIRECTORY HANDLERS *)

 FUNCTION FETCHDIR(FUNIT: UNITNUM): BOOLEAN;
   VAR LINX: DIRRANGE; OK: BOOLEAN; HNOW: INTEGER;
 BEGIN FETCHDIR := FALSE;
   WITH SYSCOM^,UNITABLE[FUNIT] DO
     BEGIN (*READ IN AND VALIDATE DIR*)
       IF GDIRP = NIL THEN NEW(GDIRP);
       UNITREAD(FUNIT,GDIRP^,SIZEOF(DIRECTORY),DIRBLK);
       OK := IORSLT = INOERROR;
       IF OK THEN
         WITH GDIRP^[0] DO
           BEGIN OK := FALSE; (*CHECK OUT DIR*)
             IF (DFIRSTBLK = 0) AND
                 (  (MISCINFO.USERKIND=BOOKER)
               OR ( (MISCINFO.USERKIND IN [AQUIZ,PQUIZ]) AND (DFKIND=SECUREDIR) )
                   OR ( (MISCINFO.USERKIND=NORMAL) AND (DFKIND=UNTYPEDFILE) ) )
               THEN
               IF (LENGTH(DVID) > 0) AND (LENGTH(DVID) <= VIDLENG) AND
                  (DNUMFILES >= 0) AND (DNUMFILES <= MAXDIR) THEN
                 BEGIN OK := TRUE; (*SO FAR SO GOOD*)
                   IF DVID <> UVID THEN
                     BEGIN (*NEW VOLUME IN UNIT...CAREFUL*)
                       LINX := 1;
                       WHILE LINX <= DNUMFILES DO
                         WITH GDIRP^[LINX] DO
                           IF (LENGTH(DTID) <= 0) OR
                              (LENGTH(DTID) > TIDLENG) OR
                              (DLASTBLK < DFIRSTBLK) OR
                              (DLASTBYTE > FBLKSIZE) OR
                              (DLASTBYTE <= 0) OR
                              (DACCESS.YEAR >= 100) THEN
                             BEGIN OK := FALSE; DELENTRY(LINX,GDIRP) END
                           ELSE
                             LINX := LINX+1;
                       IF NOT OK THEN
                         BEGIN (*MUST HAVE BEEN CHANGED...WRITEIT*)
                           UNITWRITE(FUNIT,GDIRP^,
                                 (DNUMFILES+1)*SIZEOF(DIRENTRY),DIRBLK);
                           OK := IORSLT = INOERROR
                         END
                     END
                 END;
             IF OK THEN
               BEGIN UVID := DVID; UEOVBLK := DEOVBLK;
                 TIME(HNOW,DLOADTIME)
               END
           END;
       FETCHDIR := OK;
       IF NOT OK THEN
         BEGIN UVID := ''; UEOVBLK := MMAXINT;
           RELEASE(GDIRP); GDIRP := NIL
         END
     END
 END (*FETCHDIR*) ;

 PROCEDURE WRITEDIR(*FUNIT: UNITNUM; FDIR: DIRP*);
   VAR HNOW,LNOW: INTEGER; OK: BOOLEAN; LDE: DIRENTRY;
 BEGIN
   WITH UNITABLE[FUNIT],FDIR^[0] DO
     BEGIN OK := (UVID = DVID) AND ((DFKIND = UNTYPEDFILE) OR
                                    (DFKIND = SECUREDIR));
       IF OK THEN
         BEGIN TIME(HNOW,LNOW);
           OK := (LNOW-DLOADTIME <= AGELIMIT) AND
                 ((LNOW-DLOADTIME) >= 0) AND
                     SYSCOM^.MISCINFO.HASCLOCK;
           IF NOT OK THEN
             BEGIN (*NO CLOCK OR TOO OLD*)
               UNITREAD(FUNIT,LDE,SIZEOF(DIRENTRY),DIRBLK);
               IF IORESULT = ORD(INOERROR) THEN
                 OK := DVID = LDE.DVID;
             END;

           IF OK THEN
             BEGIN (*WE GUESS ALL IS SAFE...WRITEIT*)
               DFIRSTBLK := 0;   (*DIRTY FIX FOR YALOE BUGS*)
               UNITWRITE(FUNIT,FDIR^,
                         (DNUMFILES+1)*SIZEOF(DIRENTRY),DIRBLK);
               OK := IORESULT = ORD(INOERROR);
               IF DLASTBLK = 10 THEN (*REDUNDANT AFTERTHOUGHT*)
                 UNITWRITE(FUNIT,FDIR^,
                           (DNUMFILES+1)*SIZEOF(DIRENTRY),6);
               IF OK THEN TIME(HNOW,DLOADTIME)
             END
         END;
       IF NOT OK THEN
         BEGIN SYSCOM^.IORSLT := ILOSTUNIT;
           UVID := ''; UEOVBLK := MMAXINT
         END
     END
 END (*WRITEDIR*) ;

 FUNCTION VOLSEARCH(*VAR FVID: VID; LOOKHARD: BOOLEAN; VAR FDIR: DIRP*);
   VAR LUNIT: UNITNUM; OK,PHYSUNIT: BOOLEAN; HNOW,LNOW: INTEGER;
 BEGIN VOLSEARCH := 0; FDIR := NIL;
   OK := FALSE; PHYSUNIT := FALSE;
   IF LENGTH(FVID) > 0 THEN
     BEGIN
       IF (FVID[1] = '#') AND (LENGTH(FVID) > 1) THEN
         BEGIN OK := TRUE;
           LUNIT := 0; HNOW := 2;
           REPEAT
             IF FVID[HNOW] IN DIGITS THEN
               LUNIT := LUNIT*10+ORD(FVID[HNOW])-ORD('0')
             ELSE OK := FALSE;
             HNOW := HNOW+1
           UNTIL (HNOW > LENGTH(FVID)) OR NOT OK;
           PHYSUNIT := OK AND (LUNIT > 0) AND (LUNIT <= MAXUNIT)
         END;
       IF NOT PHYSUNIT THEN
         BEGIN OK := FALSE; LUNIT := MAXUNIT;
           REPEAT
             OK := FVID = UNITABLE[LUNIT].UVID;
             IF NOT OK THEN LUNIT := LUNIT-1
           UNTIL OK OR (LUNIT = 0)
         END
     END;
   IF OK THEN
     IF UNITABLE[LUNIT].UISBLKD THEN
       WITH SYSCOM^ DO
         BEGIN OK := FALSE;  (*SEE IF GDIRP IS GOOD*)
           IF GDIRP <> NIL THEN
             IF FVID = GDIRP^[0].DVID THEN
               BEGIN TIME(HNOW,LNOW);
                 OK := LNOW-GDIRP^[0].DLOADTIME <= AGELIMIT
               END;
           IF NOT OK THEN
             BEGIN OK := PHYSUNIT;
               IF FETCHDIR(LUNIT) THEN
                 IF NOT PHYSUNIT THEN
                   OK := FVID = GDIRP^[0].DVID
             END
         END;
   IF NOT OK AND LOOKHARD THEN
     BEGIN LUNIT := MAXUNIT; (*CHECK EACH DISK UNIT*)
       REPEAT
         WITH UNITABLE[LUNIT] DO
           IF UISBLKD THEN
             IF FETCHDIR(LUNIT) THEN
               OK := FVID = UVID;
         IF NOT OK THEN LUNIT := LUNIT-1
       UNTIL OK OR (LUNIT = 0)
     END;
   IF OK THEN
     WITH UNITABLE[LUNIT] DO
       BEGIN VOLSEARCH := LUNIT;
         IF LENGTH(UVID) > 0 THEN FVID := UVID;
         IF UISBLKD AND (SYSCOM^.GDIRP <> NIL) THEN
           BEGIN FDIR := SYSCOM^.GDIRP;
             TIME(HNOW,FDIR^[0].DLOADTIME)
           END
       END
 END (*VOLSEARCH*) ;

 FUNCTION DIRSEARCH(*VAR FTID: TID; FINDPERM: BOOLEAN; FDIR: DIRP*);
   VAR I: DIRRANGE; FOUND: BOOLEAN;
 BEGIN DIRSEARCH := 0; FOUND := FALSE; I := 1;
   WHILE (I <= FDIR^[0].DNUMFILES) AND NOT FOUND DO
     BEGIN
       WITH FDIR^[I] DO
         IF DTID = FTID THEN
           IF FINDPERM = (DACCESS.YEAR <> 100) THEN
             BEGIN DIRSEARCH := I; FOUND := TRUE END;
       I := I+1
     END
 END (*DIRSEARCH*) ;

 PROCEDURE DELENTRY(*FINX: DIRRANGE; FDIR: DIRP*);
   VAR I: DIRRANGE;
 BEGIN
   WITH FDIR^[0] DO
     BEGIN
       FOR I := FINX TO DNUMFILES-1 DO
         FDIR^[I] := FDIR^[I+1];
       FDIR^[DNUMFILES].DTID := '';
       DNUMFILES := DNUMFILES-1
     END
 END (*DELENTRY*) ;

 PROCEDURE INSENTRY(*VAR FENTRY: DIRENTRY; FINX: DIRRANGE; FDIR: DIRP*);
   VAR I: DIRRANGE;
 BEGIN
   WITH FDIR^[0] DO
     BEGIN
       FOR I := DNUMFILES DOWNTO FINX DO
         FDIR^[I+1] := FDIR^[I];
       FDIR^[FINX] := FENTRY;
       DNUMFILES := DNUMFILES+1
     END
 END (*INSENTRY*) ;

 FUNCTION ENTERTEMP(VAR FTID: TID; FSEGS: INTEGER;
                       FKIND: FILEKIND; FDIR: DIRP): DIRRANGE;
   VAR I,LASTI,DINX,SINX: DIRRANGE; RT11ISH: BOOLEAN;
       SSEGS: INTEGER; LDE: DIRENTRY;

   PROCEDURE FINDMAX(CURINX: DIRRANGE; FIRSTOPEN,NEXTUSED: INTEGER);
     VAR FREEAREA: INTEGER;
   BEGIN
     FREEAREA := NEXTUSED-FIRSTOPEN;
     IF FREEAREA > FSEGS THEN
       BEGIN
         SINX := DINX; SSEGS := FSEGS;
         DINX := CURINX; FSEGS := FREEAREA
       END
     ELSE
       IF FREEAREA > SSEGS THEN
         BEGIN SSEGS := FREEAREA; SINX := CURINX END
   END (*FINDMAX*) ;

 BEGIN (*ENTERTEMP*)
   DINX := 0; LASTI := FDIR^[0].DNUMFILES;
   SINX := 0; SSEGS := 0;
   IF FSEGS <= 0 THEN
     BEGIN RT11ISH := FSEGS < 0;
       FOR I := 1 TO LASTI DO
         FINDMAX(I,FDIR^[I-1].DLASTBLK,FDIR^[I].DFIRSTBLK);
       FINDMAX(LASTI+1,FDIR^[LASTI].DLASTBLK,FDIR^[0].DEOVBLK);
       IF RT11ISH THEN
         IF FSEGS DIV 2 <= SSEGS THEN
           BEGIN FSEGS := SSEGS; DINX := SINX END
         ELSE FSEGS := (FSEGS+1) DIV 2
     END
   ELSE
     BEGIN I := 1;
       WHILE I <= LASTI DO
         BEGIN
           IF FDIR^[I].DFIRSTBLK-FDIR^[I-1].DLASTBLK >= FSEGS THEN
             BEGIN DINX := I; I := LASTI END;
           I := I+1
         END;
       IF DINX = 0 THEN
         IF FDIR^[0].DEOVBLK-FDIR^[LASTI].DLASTBLK >= FSEGS THEN
           DINX := LASTI+1
     END;
   IF LASTI = MAXDIR THEN DINX := 0;
   IF DINX > 0 THEN
     BEGIN
       WITH LDE DO
         BEGIN
           DFIRSTBLK := FDIR^[DINX-1].DLASTBLK;
           DLASTBLK := DFIRSTBLK+FSEGS;
           DFKIND := FKIND; DTID := FTID;
           DLASTBYTE := FBLKSIZE;
           WITH DACCESS DO
             BEGIN MONTH := 0; DAY := 0; YEAR := 100 END
         END;
       INSENTRY(LDE,DINX,FDIR)
     END;
   ENTERTEMP := DINX
 END (*ENTERTEMP*) ;

 (* FILE STATE HANDLERS *)

 PROCEDURE FINIT(*VAR F: FIB; WINDOW: WINDOWP; RECWORDS: INTEGER*);
 BEGIN
   WITH F DO
     BEGIN FSTATE := FJANDW;
       FISOPEN := FALSE; FEOF := TRUE;
       FEOLN := TRUE; FWINDOW := WINDOW;
       IF (RECWORDS = 0) OR (RECWORDS = -2) THEN
         BEGIN
           FWINDOW^[1] := CHR(0); FRECSIZE := 1;
           IF RECWORDS = 0 THEN FSTATE := FNEEDCHAR
         END
       ELSE
         IF RECWORDS < 0 THEN
           BEGIN FWINDOW := NIL; FRECSIZE := 0 END
         ELSE FRECSIZE := RECWORDS+RECWORDS
     END
 END (*FINIT*) ;

 PROCEDURE RESETER(VAR F:FIB);
   VAR BIGGER: BOOLEAN;
 BEGIN
   WITH F DO
      BEGIN FREPTCNT := 0;
         FEOLN := FALSE; FEOF := FALSE;
         IF FISBLKD THEN
           BEGIN BIGGER := FNXTBLK > FMAXBLK;
             IF BIGGER THEN FMAXBLK := FNXTBLK;
             IF FSOFTBUF THEN
               BEGIN
                 IF BIGGER THEN FMAXBYTE := FNXTBYTE
                 ELSE
                   IF FNXTBLK = FMAXBLK THEN
                     IF FNXTBYTE > FMAXBYTE THEN
                         BEGIN BIGGER := TRUE; FMAXBYTE := FNXTBYTE END;
                 IF FBUFCHNGD THEN
                   BEGIN FBUFCHNGD := FALSE; FMODIFIED := TRUE;
                     IF BIGGER THEN
                       FILLCHAR(FBUFFER[FNXTBYTE],FBLKSIZE-FNXTBYTE,0);
                     UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,
                                     FHEADER.DFIRSTBLK+FNXTBLK-1);
                     IF BIGGER AND (FHEADER.DFKIND = TEXTFILE)
                         AND ODD(FNXTBLK) THEN
                       BEGIN FMAXBLK := FMAXBLK+1;
                         FILLCHAR(FBUFFER,FBLKSIZE,0);
                         UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,
                                         FHEADER.DFIRSTBLK+FNXTBLK)
                       END
                   END;
                 FNXTBYTE := FBLKSIZE
               END;
             FNXTBLK := 0;
             IF FSOFTBUF AND (FHEADER.DFKIND = TEXTFILE) THEN
                 FNXTBLK := 2
           END
      END
 END (*RESETER*) ;

 PROCEDURE FOPEN(*VAR F: FIB; VAR FTITLE: STRING;
                  FOPENOLD: BOOLEAN; JUNK PARAM*);
   LABEL 1;
   VAR LDIR: DIRP; LUNIT: UNITNUM; LINX: DIRRANGE;
       LSEGS,NBYTES: INTEGER; LKIND: FILEKIND;
       OLDHEAP: ^INTEGER; SWAPPED: BOOLEAN;
       SAVERSLT: IORSLTWD; LVID: VID; LTID: TID;
 BEGIN SYSCOM^.IORSLT := INOERROR;
   WITH F DO
     IF FISOPEN THEN SYSCOM^.IORSLT := INOTCLOSED
     ELSE
       IF SCANTITLE(FTITLE,LVID,LTID,LSEGS,LKIND) THEN
         BEGIN (*GOT AN OK TITLE*)
           IF ORD(FOPENOLD) > 1 THEN (*OLD CODE SPECIAL CASE*)
             FOPENOLD := (ORD(FOPENOLD) = 2) OR (ORD(FOPENOLD) = 4);
           SWAPPED := FALSE;
           WITH SWAPFIB^ DO
             IF FISOPEN AND (SYSCOM^.GDIRP = NIL) THEN
               BEGIN MARK(OLDHEAP);
                 NBYTES := ORD(SYSCOM^.LASTMP)-ORD(OLDHEAP);
                 IF (NBYTES > 0) AND (NBYTES < SIZEOF(DIRECTORY)+400) THEN
                   BEGIN
                     NBYTES := ORD(OLDHEAP)-ORD(EMPTYHEAP);
                     IF (NBYTES > 0) AND (NBYTES > SIZEOF(DIRECTORY)) AND
                         (UNITABLE[FUNIT].UVID = FVID) THEN
                       BEGIN
                         UNITWRITE(FUNIT,EMPTYHEAP^,SIZEOF(DIRECTORY),
                                         FHEADER.DFIRSTBLK);
                         RELEASE(EMPTYHEAP); SWAPPED := TRUE
                       END
                   END
               END;
           LUNIT := VOLSEARCH(LVID,TRUE,LDIR);
           IF LUNIT = 0 THEN SYSCOM^.IORSLT := INOUNIT
           ELSE
             WITH UNITABLE[LUNIT] DO
               BEGIN (*OK...OPEN UP FILE*)
                 FISOPEN := TRUE; FMODIFIED := FALSE;
                 FUNIT := LUNIT; FVID := LVID;
                 FNXTBLK := 0; FISBLKD := UISBLKD;
                 FSOFTBUF := UISBLKD AND (FRECSIZE <> 0);
                 IF (LDIR <> NIL) AND (LENGTH(LTID) > 0) THEN
                   BEGIN (*LOOKUP OR ENTER FHEADER IN DIRECTORY*)
                     LINX := DIRSEARCH(LTID,FOPENOLD,LDIR);
                     IF FOPENOLD THEN
                       IF LINX = 0 THEN
                         BEGIN SYSCOM^.IORSLT := INOFILE; GOTO 1 END
                       ELSE FHEADER := LDIR^[LINX]
                     ELSE (*OPEN NEW FILE*)
                       IF LINX > 0 THEN
                         BEGIN SYSCOM^.IORSLT := IDUPFILE; GOTO 1 END
                       ELSE
                         BEGIN (*MAKE A TEMP ENTRY*)
                           IF LKIND = UNTYPEDFILE THEN LKIND := DATAFILE;
                           LINX := ENTERTEMP(LTID,LSEGS,LKIND,LDIR);
                           IF (LINX > 0) AND (LKIND = TEXTFILE) THEN
                             WITH LDIR^[LINX] DO
                               BEGIN
                                 IF ODD(DLASTBLK-DFIRSTBLK) THEN
                                   DLASTBLK := DLASTBLK-1;
                                 IF DLASTBLK-DFIRSTBLK < 4 THEN
                                   BEGIN DELENTRY(LINX,LDIR); LINX := 0 END
                               END;
                           IF LINX = 0 THEN
                             BEGIN SYSCOM^.IORSLT := INOROOM; GOTO 1 END;
                           FHEADER := LDIR^[LINX]; FMODIFIED := TRUE;
                           WRITEDIR(LUNIT,LDIR)
                         END
                   END
                 ELSE (*FHEADER NOT IN DIRECTORY*)
                   WITH FHEADER DO
                     BEGIN (*DIRECT UNIT OPEN, SET UP DUMMY FHEADER*)
                       DFIRSTBLK := 0; DLASTBLK := MMAXINT;
                       IF UISBLKD THEN DLASTBLK := UEOVBLK;
                       DFKIND := LKIND; DTID := '';
                       DLASTBYTE := FBLKSIZE;
                       WITH DACCESS DO
                         BEGIN MONTH := 0; DAY := 0; YEAR := 0 END
                     END;
                 IF FOPENOLD THEN
                   FMAXBLK := FHEADER.DLASTBLK-FHEADER.DFIRSTBLK
                 ELSE FMAXBLK := 0;
                 IF FSOFTBUF THEN
                   BEGIN
                     FNXTBYTE := FBLKSIZE; FBUFCHNGD := FALSE;
                     IF FOPENOLD THEN FMAXBYTE := FHEADER.DLASTBYTE
                     ELSE FMAXBYTE := FBLKSIZE;
                     WITH FHEADER DO
                       IF DFKIND = TEXTFILE THEN
                         BEGIN FNXTBLK := 2;
                           IF NOT FOPENOLD THEN
                             BEGIN (*NEW .TEXT, PUT NULLS IN FIRST PAGE*)
                               FILLCHAR(FBUFFER,SIZEOF(FBUFFER),0);
                               UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK);
                               UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+1)
                             END
                         END
                   END;
                 IF FOPENOLD THEN FRESET(F)
                 ELSE RESETER(F); (*NO GET!*)
         1:      IF IORESULT <> ORD(INOERROR) THEN
                   BEGIN FISOPEN := FALSE; FEOF := TRUE; FEOLN := TRUE END
               END;
           IF SWAPPED THEN
             BEGIN RELEASE(OLDHEAP); SYSCOM^.GDIRP := NIL;
               SAVERSLT := SYSCOM^.IORSLT;
               UNITREAD(SWAPFIB^.FUNIT,EMPTYHEAP^,SIZEOF(DIRECTORY),
                                 SWAPFIB^.FHEADER.DFIRSTBLK);
               SYSCOM^.IORSLT := SAVERSLT
             END
         END
       ELSE SYSCOM^.IORSLT := IBADTITLE
 END (*FOPEN*) ;

 PROCEDURE FCLOSE(*VAR F: FIB; FTYPE: CLOSETYPE*);
   LABEL 1;
   VAR LINX,DUPINX: DIRRANGE; LDIR: DIRP; FOUND: BOOLEAN;
 BEGIN SYSCOM^.IORSLT := INOERROR;
   WITH F DO
     IF FISOPEN AND (FWINDOW <> SYSTERM^.FWINDOW) THEN
       BEGIN
         IF FISBLKD THEN
           WITH FHEADER DO
             IF LENGTH(DTID) > 0 THEN
               BEGIN (*FILE IN A DISK DIRECTORY...FIXUP MAYBE*)
                 IF FTYPE = CCRUNCH THEN
                   BEGIN FMAXBLK := FNXTBLK;
                     DACCESS.YEAR := 100; FTYPE := CLOCK;
                     IF FSOFTBUF THEN FMAXBYTE := FNXTBYTE
                   END;
                 RESETER(F);
                 IF FMODIFIED OR (DACCESS.YEAR = 100) OR (FTYPE = CPURGE) THEN
                   BEGIN (*HAVE TO CHANGE DIRECTORY ENTRY*)
                     IF FUNIT <> VOLSEARCH(FVID,FALSE,LDIR) THEN
                       BEGIN SYSCOM^.IORSLT := ILOSTUNIT; GOTO 1 END;
                     LINX := 1; FOUND := FALSE;
                     WHILE (LINX <= LDIR^[0].DNUMFILES) AND NOT FOUND DO
                       BEGIN (*LOOK FOR FIRST BLOCK MATCH*)
                         FOUND := (LDIR^[LINX].DFIRSTBLK = DFIRSTBLK) AND
                                  (LDIR^[LINX].DLASTBLK = DLASTBLK);
                         LINX := LINX + 1
                       END;
                     IF NOT FOUND THEN
                       BEGIN SYSCOM^.IORSLT := ILOSTFILE; GOTO 1 END;
                     LINX := LINX - 1; (*CORRECT OVERRUN*)
                     IF ((FTYPE = CNORMAL) AND (LDIR^[LINX].DACCESS.YEAR = 100))
                            OR (FTYPE = CPURGE) THEN
                         DELENTRY(LINX,LDIR)  (*ZAP FILE OUT OF EXISTANCE*)
                     ELSE
                       BEGIN (*WELL...LOCK IN A PERM DIR ENTRY*)
                         DUPINX := DIRSEARCH(DTID,TRUE,LDIR);
                         IF (DUPINX <> 0) AND (DUPINX <> LINX) THEN
                           BEGIN (*A DUPLICATE PERM ENTRY...ZAP OLD ONE*)
                             DELENTRY(DUPINX,LDIR);
                             IF DUPINX < LINX THEN LINX := LINX-1
                           END;
                         IF LDIR^[LINX].DACCESS.YEAR = 100 THEN
                           IF DACCESS.YEAR = 100 THEN
                             DACCESS := THEDATE
                           ELSE (*LEAVE ALONE...FILER SPECIAL CASE*)
                         ELSE
                           IF FMODIFIED AND (THEDATE.MONTH <> 0) THEN
                             DACCESS := THEDATE
                           ELSE
                             DACCESS := LDIR^[LINX].DACCESS;
                         DLASTBLK := DFIRSTBLK+FMAXBLK;
                         IF FSOFTBUF THEN DLASTBYTE := FMAXBYTE;
                         FMODIFIED := FALSE; LDIR^[LINX] := FHEADER
                       END;
                     WRITEDIR(FUNIT,LDIR)
                   END
               END;
         IF FTYPE = CPURGE THEN
           IF LENGTH(FHEADER.DTID) = 0 THEN
             UNITABLE[FUNIT].UVID := '';
 1:      FEOF := TRUE; FEOLN := TRUE; FISOPEN := FALSE
       END
 END (*FCLOSE*) ;
 { $I SYSTEM.C }

     (******************************************************************)
     (*                                                                *)
     (*  Copyright (c) 1978 Regents of the University of California.   *)
     (*  Permission to copy or distribute this software or documen-    *)
     (*  tation in hard or soft copy granted only by written license   *)
     (*  obtained from the Institute for Information Systems.          *)
     (*                                                                *)
     (******************************************************************)

 (* INPUT-OUTPUT PRIMITIVES *)

 PROCEDURE XSEEK;
 BEGIN
   SYSCOM^.XEQERR := 11; { NOT IMP ERR }
   EXECERROR
 END (*XSEEK*) ;

 PROCEDURE XREADREAL;
 BEGIN
   SYSCOM^.XEQERR := 11; { NOT IMP ERR }
   EXECERROR
 END (*XREADREAL*) ;

 PROCEDURE XWRITEREAL;
 BEGIN
   SYSCOM^.XEQERR := 11; { NOT IMP ERR }
   EXECERROR
 END (*XWRITEREAL*) ;

 FUNCTION CANTSTRETCH(VAR F: FIB): BOOLEAN; (*REPLACED BY RJH 2Mar78*)
   LABEL 1;
   VAR LINX: DIRRANGE; FOUND,OK: BOOLEAN; LAVAILBLK: INTEGER; LDIR: DIRP;
 BEGIN CANTSTRETCH := TRUE; OK := FALSE;

   WITH F,FHEADER DO
     IF LENGTH(DTID) > 0 THEN
       BEGIN (*IN A DIRECTORY FOR SURE*)
         IF FUNIT <> VOLSEARCH(FVID,FALSE,LDIR) THEN
           BEGIN SYSCOM^.IORSLT := ILOSTUNIT; GOTO 1 END;
         FOUND := FALSE; LINX := 1;
         WHILE (LINX <= LDIR^[0].DNUMFILES) AND NOT FOUND DO
           BEGIN
             FOUND := (LDIR^[LINX].DFIRSTBLK = DFIRSTBLK) AND
                      (LDIR^[LINX].DLASTBLK = DLASTBLK);
             LINX := LINX+1
           END;
         IF NOT FOUND THEN
           BEGIN SYSCOM^.IORSLT := ILOSTFILE; GOTO 1 END;
         IF LINX > LDIR^[0].DNUMFILES THEN
           LAVAILBLK := LDIR^[0].DEOVBLK
         ELSE LAVAILBLK := LDIR^[LINX].DFIRSTBLK;
         IF (DLASTBLK < LAVAILBLK) OR (DLASTBYTE < FBLKSIZE) THEN
           BEGIN
             WITH LDIR^[LINX-1] DO
               BEGIN
                 DLASTBLK := LAVAILBLK; DLASTBYTE := FBLKSIZE;
                 WRITEDIR(FUNIT,LDIR);
                 IF IORESULT <> ORD(INOERROR) THEN GOTO 1
               END;
             FEOF := FALSE; FEOLN := FALSE;
             IF FSTATE <> FJANDW THEN FSTATE := FNEEDCHAR; (*RJH 2Mar78*)
             DLASTBLK := LAVAILBLK; DLASTBYTE := FBLKSIZE;
             DACCESS.YEAR := 100; CANTSTRETCH := FALSE
           END;
         OK := TRUE;
       END;
 1:  IF NOT OK THEN
       BEGIN F.FEOF := TRUE; F.FEOLN := TRUE END
 END (*CANTSTRETCH*) ;

 PROCEDURE FRESET(*VAR F: FIB*);
 BEGIN SYSCOM^.IORSLT := INOERROR;
   WITH F DO
     IF FISOPEN THEN
       BEGIN RESETER(F);
         IF FRECSIZE > 0 THEN
           IF FSTATE = FJANDW THEN FGET(F)
           ELSE FSTATE := FNEEDCHAR
       END
 END (*FRESET*) ;

 FUNCTION FBLOCKIO(*VAR F: FIB; VAR A: WINDOW;
                    NBLOCKS,RBLOCK: INTEGER; DOREAD: BOOLEAN*);
 BEGIN FBLOCKIO := 0; SYSCOM^.IORSLT := INOERROR;
   WITH F DO
     IF FISOPEN AND (NBLOCKS >= 0) THEN
       IF FISBLKD THEN
         WITH FHEADER DO
           BEGIN
             IF RBLOCK < 0 THEN RBLOCK := FNXTBLK;
             RBLOCK := DFIRSTBLK+RBLOCK;
             IF RBLOCK+NBLOCKS > DLASTBLK THEN
               IF NOT DOREAD THEN
                 IF CANTSTRETCH( F ) THEN;
             IF RBLOCK+NBLOCKS > DLASTBLK THEN
               NBLOCKS := DLASTBLK-RBLOCK;
             FEOF := RBLOCK >= DLASTBLK;
             IF NOT FEOF THEN
               BEGIN
                 IF DOREAD THEN
                   UNITREAD(FUNIT,A,NBLOCKS*FBLKSIZE,RBLOCK)
                 ELSE
                   BEGIN FMODIFIED := TRUE;
                     UNITWRITE(FUNIT,A,NBLOCKS*FBLKSIZE,RBLOCK)
                   END;
                 FBLOCKIO := NBLOCKS;
                 RBLOCK := RBLOCK+NBLOCKS;
                 FEOF := RBLOCK = DLASTBLK;
                 FNXTBLK := RBLOCK-DFIRSTBLK;
                 IF FNXTBLK > FMAXBLK THEN FMAXBLK := FNXTBLK
               END
           END
       ELSE
         BEGIN FBLOCKIO := NBLOCKS;
           IF DOREAD THEN
             UNITREAD(FUNIT,A,NBLOCKS*FBLKSIZE,RBLOCK)
           ELSE
             UNITWRITE(FUNIT,A,NBLOCKS*FBLKSIZE,RBLOCK);
           IF IORESULT = ORD(INOERROR) THEN
             IF DOREAD THEN
               BEGIN RBLOCK := NBLOCKS*FBLKSIZE;
                 RBLOCK := RBLOCK+SCAN(-RBLOCK,<>CHR(0),A[RBLOCK-1]);
                 RBLOCK := (RBLOCK+FBLKSIZE-1) DIV FBLKSIZE;
                 FBLOCKIO := RBLOCK;
                 FEOF := RBLOCK < NBLOCKS
               END
             ELSE
           ELSE FBLOCKIO := 0
         END
     ELSE
       SYSCOM^.IORSLT := INOTOPEN
 END (*FBLOCKIO*) ;

 PROCEDURE FGET(*VAR F: FIB*);
   LABEL 1, 2;
   VAR LEFTOGET,WININX,LEFTINBUF,AMOUNT: INTEGER;
       DONE: BOOLEAN;
 BEGIN SYSCOM^.IORSLT := INOERROR;
   WITH F DO
     IF FISOPEN THEN
       BEGIN
         IF FREPTCNT > 0 THEN
           BEGIN FREPTCNT := FREPTCNT-1; IF FREPTCNT > 0 THEN GOTO 2 END;
         IF FSOFTBUF THEN
           WITH FHEADER DO
             BEGIN
               LEFTOGET := FRECSIZE; WININX := 0;
               REPEAT
                 IF FNXTBLK = FMAXBLK THEN
                   IF FNXTBYTE+LEFTOGET > FMAXBYTE THEN GOTO 1
                   ELSE LEFTINBUF := DLASTBYTE-FNXTBYTE
                 ELSE LEFTINBUF := FBLKSIZE-FNXTBYTE;
                 AMOUNT := LEFTOGET;
                 IF AMOUNT > LEFTINBUF THEN AMOUNT := LEFTINBUF;
                 IF AMOUNT > 0 THEN
                   BEGIN
                     MOVELEFT(FBUFFER[FNXTBYTE],FWINDOW^[WININX],AMOUNT);
                     FNXTBYTE := FNXTBYTE+AMOUNT;
                     WININX := WININX+AMOUNT;
                     LEFTOGET := LEFTOGET-AMOUNT
                   END;
                 DONE := LEFTOGET = 0;
                 IF NOT DONE THEN
                   BEGIN
                     IF FBUFCHNGD THEN
                       BEGIN FBUFCHNGD := FALSE; FMODIFIED := TRUE;
                         UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+FNXTBLK-1)
                       END;
                     IF IORESULT <> ORD(INOERROR) THEN GOTO 1;
                     UNITREAD(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+FNXTBLK);
                     IF IORESULT <> ORD(INOERROR) THEN GOTO 1;
                     FNXTBLK := FNXTBLK+1; FNXTBYTE := 0
                   END
               UNTIL DONE
             END
         ELSE
           BEGIN
             UNITREAD(FUNIT,FWINDOW^,FRECSIZE);
             IF IORESULT <> ORD(INOERROR) THEN GOTO 1
           END;
         IF FRECSIZE = 1 THEN (*FILE OF CHAR*)
           BEGIN FEOLN := FALSE;
             IF FSTATE <> FJANDW THEN FSTATE := FGOTCHAR;
             IF FWINDOW^[0] = CHR(EOL) THEN
               BEGIN FWINDOW^[0] := ' '; FEOLN := TRUE; GOTO 2 END;
             IF FWINDOW^[0] = CHR(DLE) THEN
               BEGIN FGET(F);
                 AMOUNT := ORD(FWINDOW^[0])-32;
                 IF (AMOUNT > 0) AND (AMOUNT <= 127) THEN
                   BEGIN
                     FWINDOW^[0] := ' ';
                     FREPTCNT := AMOUNT;
                     GOTO 2
                   END;
                 FGET(F)
               END;
             IF FWINDOW^[0] = CHR(0) THEN
               BEGIN (*EOF HANDLING*)
                 IF FSOFTBUF AND (FHEADER.DFKIND = TEXTFILE) THEN
                   BEGIN (*END OF 2 BLOCK PAGE*)
                     IF ODD(FNXTBLK) THEN FNXTBLK := FNXTBLK+1;
                     FNXTBYTE := FBLKSIZE; FGET(F)
                   END
                 ELSE
                   BEGIN FWINDOW^[0] := ' '; GOTO 1 END
               END
           END
       END
     ELSE
       BEGIN
         SYSCOM^.IORSLT := INOTOPEN;
 1:      FEOF := TRUE; FEOLN := TRUE
       END;
 2:
 END (*FGET*) ;

 PROCEDURE FPUT(*VAR F: FIB*);
   LABEL 1;
   VAR LEFTOPUT,WININX,LEFTINBUF,AMOUNT: INTEGER;
       DONE: BOOLEAN;
 BEGIN SYSCOM^.IORSLT := INOERROR;
   WITH F DO
     IF FISOPEN THEN
       BEGIN
         IF FSOFTBUF THEN
           WITH FHEADER DO
             BEGIN
               LEFTOPUT := FRECSIZE; WININX := 0;
               REPEAT
                 IF DFIRSTBLK+FNXTBLK = DLASTBLK THEN
                   IF FNXTBYTE+LEFTOPUT > DLASTBYTE THEN
                     IF CANTSTRETCH( F ) THEN
                         BEGIN SYSCOM^.IORSLT := INOROOM; GOTO 1 END
                     ELSE LEFTINBUF := FBLKSIZE-FNXTBYTE
                   ELSE LEFTINBUF := DLASTBYTE-FNXTBYTE
                 ELSE LEFTINBUF := FBLKSIZE-FNXTBYTE;
                 AMOUNT := LEFTOPUT;
                 IF AMOUNT > LEFTINBUF THEN AMOUNT := LEFTINBUF;
                 IF AMOUNT > 0 THEN
                   BEGIN FBUFCHNGD := TRUE;
                     MOVELEFT(FWINDOW^[WININX],FBUFFER[FNXTBYTE],AMOUNT);
                     FNXTBYTE := FNXTBYTE+AMOUNT;
                     WININX := WININX+AMOUNT;
                     LEFTOPUT := LEFTOPUT-AMOUNT
                   END;
                 DONE := LEFTOPUT = 0;
                 IF NOT DONE THEN
                   BEGIN
                     IF FBUFCHNGD THEN
                       BEGIN FBUFCHNGD := FALSE; FMODIFIED := TRUE;
                         UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+FNXTBLK-1)
                       END;
                     IF IORESULT <> ORD(INOERROR) THEN GOTO 1;
                     IF FNXTBLK < FMAXBLK THEN
                       UNITREAD(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+FNXTBLK)
                     ELSE
                       FILLCHAR(FBUFFER,FBLKSIZE,CHR(0));
                     IF IORESULT <> ORD(INOERROR) THEN GOTO 1;
                     FNXTBLK := FNXTBLK+1; FNXTBYTE := 0
                   END
               UNTIL DONE;
               IF FRECSIZE = 1 THEN
                 IF FWINDOW^[0] = CHR(EOL) THEN
                   IF DFKIND = TEXTFILE THEN
                     IF (FNXTBYTE >= FBLKSIZE-127) AND NOT ODD(FNXTBLK) THEN
                       BEGIN
                         FNXTBYTE := FBLKSIZE-1;
                         FWINDOW^[0] := CHR(0);
                         FPUT(F)
                       END
             END
         ELSE
           BEGIN
             UNITWRITE(FUNIT,FWINDOW^,FRECSIZE);
             IF IORESULT <> ORD(INOERROR) THEN GOTO 1
           END
       END
     ELSE
       BEGIN
         SYSCOM^.IORSLT := INOTOPEN;
 1:      FEOF := TRUE; FEOLN := TRUE
       END
 END (*FPUT*) ;

 FUNCTION FEOF(*VAR F: FIB*);
 BEGIN FEOF := F.FEOF END;

 (* TEXT FILE INTRINSICS *)

 FUNCTION FEOLN(*VAR F: FIB*);
 BEGIN FEOLN := F.FEOLN END;

 PROCEDURE FWRITELN(*VAR F: FIB*);
 BEGIN
   F.FWINDOW^[0] := CHR(EOL); FPUT(F)
 END (*FWRITELN*) ;

 PROCEDURE FWRITECHAR(*VAR F: FIB; CH: CHAR; RLENG: INTEGER*);
   LABEL  1;
 BEGIN
   WITH F DO
     IF FISOPEN THEN
       IF FSOFTBUF THEN
         BEGIN
           WHILE RLENG > 1 DO
             BEGIN FWINDOW^[0] := ' '; FPUT(F);
               RLENG := RLENG-1
             END;
           FWINDOW^[0] := CH; FPUT(F)
         END
       ELSE
         BEGIN
           WHILE RLENG > 1 DO
             BEGIN FWINDOW^[0] := ' ';
               UNITWRITE(FUNIT,FWINDOW^,1);
               RLENG := RLENG-1
             END;
           FWINDOW^[0] := CH;
           UNITWRITE(FUNIT,FWINDOW^,1)
         END
     ELSE SYSCOM^.IORSLT := INOTOPEN;
 1:
 END (*FWRITECHAR*) ;

 PROCEDURE FWRITEINT(*VAR F: FIB; I,RLENG: INTEGER*);
   LABEL 1;
   VAR POT,COL: INTEGER; CH: CHAR;
       SUPPRESSING: BOOLEAN; S: STRING[10];
 BEGIN COL := 1;
   S[0] := CHR(10); SUPPRESSING := TRUE;
   IF I < 0 THEN
     BEGIN I := ABS(I); S[1] := '-'; COL := 2;
       IF I = 0 THEN (*HARDWARE SPECIAL CASE*)
         BEGIN S := '-32768'; GOTO 1 END
     END;
   FOR POT := 4 DOWNTO 0 DO
     BEGIN CH := CHR(I DIV IPOT[POT] + ORD('0'));
       IF (CH = '0') AND (POT > 0) AND SUPPRESSING THEN
       ELSE (*FORMAT THE CHAR*)
         BEGIN SUPPRESSING := FALSE;
           S[COL] := CH; COL := COL+1;
           IF CH <> '0' THEN I := I MOD IPOT[POT]
         END
     END;
   S[0] := CHR(COL-1);
 1:IF RLENG < LENGTH(S) THEN
     RLENG := LENGTH(S);
   FWRITESTRING(F,S,RLENG)
 END (*FWRITEINT*) ;

 PROCEDURE FWRITESTRING(*VAR F: FIB; VAR S: STRING; RLENG: INTEGER*);
   VAR SINX: INTEGER;
 BEGIN
   WITH F DO
     IF FISOPEN THEN
       BEGIN
         IF RLENG <= 0 THEN RLENG := LENGTH(S);
         IF RLENG > LENGTH(S) THEN
           BEGIN FWRITECHAR(F,' ',RLENG-LENGTH(S)); RLENG := LENGTH(S) END;
         IF FSOFTBUF THEN
           BEGIN SINX := 1;
             WHILE (SINX <= RLENG) AND NOT FEOF DO
               BEGIN FWINDOW^[0] := S[SINX]; FPUT(F); SINX := SINX+1 END
           END
         ELSE
           UNITWRITE(FUNIT,S[1],RLENG)
       END
     ELSE SYSCOM^.IORSLT := INOTOPEN
 END (*FWRITESTRING*) ;

 PROCEDURE FREADSTRING(*VAR F: FIB; VAR S: STRING; SLENG: INTEGER*);
   VAR SINX: INTEGER; CH: CHAR;
 BEGIN
   WITH F DO
       BEGIN SINX := 1;
         IF FSTATE = FNEEDCHAR THEN FGET(F);
         S[0] := CHR(SLENG); (*NO INV INDEX*)
         WHILE (SINX <= SLENG) AND NOT (FEOLN OR FEOF) DO
           BEGIN CH := FWINDOW^[0];
             IF FUNIT = 1 THEN
               IF CHECKDEL(CH,SINX) THEN
               ELSE
                 BEGIN S[SINX] := CH; SINX := SINX + 1 END
             ELSE
               BEGIN S[SINX] := CH; SINX := SINX + 1 END;
             FGET(F)
           END;
         S[0] := CHR(SINX - 1);
         WHILE NOT FEOLN DO FGET(F)
       END
 END (*FREADSTRING*) ;

 PROCEDURE FWRITEBYTES(*VAR F: FIB; VAR A: WINDOW; RLENG,ALENG: INTEGER*);
   VAR AINX: INTEGER;
 BEGIN
   WITH F DO
     IF FISOPEN THEN
       BEGIN
         IF RLENG > ALENG THEN
           BEGIN FWRITECHAR(F,' ',RLENG-ALENG); RLENG := ALENG END;
         IF FSOFTBUF THEN
           BEGIN AINX := 0;
             WHILE (AINX < RLENG) AND NOT FEOF DO
               BEGIN FWINDOW^[0] := A[AINX]; FPUT(F); AINX := AINX+1 END
           END
         ELSE
           UNITWRITE(FUNIT,A,RLENG)
       END
     ELSE SYSCOM^.IORSLT := INOTOPEN
 END (*FWRITEBYTES*) ;

 PROCEDURE FREADLN(*VAR F: FIB*);
 BEGIN
   WHILE NOT F.FEOLN DO FGET(F);
   IF F.FSTATE = FJANDW THEN FGET(F)
   ELSE
     BEGIN F.FSTATE := FNEEDCHAR; F.FEOLN := FALSE END
 END (*FREADLN*) ;

 PROCEDURE FREADCHAR(*VAR F: FIB; VAR CH: CHAR*);
 BEGIN
   WITH F DO
       BEGIN SYSCOM^.IORSLT := INOERROR;
         IF FSTATE = FNEEDCHAR THEN FGET(F);
         CH := FWINDOW^[0];
         IF FSTATE = FJANDW THEN FGET(F)
         ELSE FSTATE := FNEEDCHAR
       END
 END (*FREADCHAR*) ;

 PROCEDURE FREADINT(*VAR F: FIB; VAR I: INTEGER*);
   LABEL 1;
   VAR CH: CHAR; NEG,IVALID: BOOLEAN; SINX: INTEGER;
 BEGIN
   WITH F DO
       BEGIN I := 0; NEG := FALSE; IVALID := FALSE;
         IF FSTATE = FNEEDCHAR THEN FGET(F);
         WHILE (FWINDOW^[0] = ' ') AND NOT FEOF DO FGET(F);
         IF FEOF THEN GOTO 1;
         CH := FWINDOW^[0];
         IF (CH = '+') OR (CH = '-') THEN
           BEGIN NEG := CH = '-'; FGET(F); CH := FWINDOW^[0] END;
         IF CH IN DIGITS THEN
           BEGIN  IVALID := TRUE; SINX := 1;
             REPEAT
               I := I*10+ORD(CH)-ORD('0');
               FGET(F); CH := FWINDOW^[0]; SINX := SINX+1;
               IF FUNIT = 1 THEN
                 WHILE CHECKDEL(CH,SINX) DO
                   BEGIN
                     IF SINX = 1 THEN I := 0 ELSE I := I DIV 10;
                     FGET(F); CH := FWINDOW^[0]
                   END
             UNTIL NOT (CH IN DIGITS) OR FEOLN
           END;
         IF IVALID OR FEOF THEN
           IF NEG THEN I := -I ELSE (*NADA*)
         ELSE SYSCOM^.IORSLT := IBADFORMAT
       END;
 1:
 END (*FREADINT*) ;

 (* STRING VARIABLE INTRINSICS *)

 PROCEDURE SCONCAT(*VAR SRC,DEST: STRING; DESTLENG: INTEGER*);
 BEGIN
   IF LENGTH(SRC)+LENGTH(DEST) <= DESTLENG THEN
     BEGIN
       MOVELEFT(SRC[1],DEST[LENGTH(DEST)+1],LENGTH(SRC));
       DEST[0] := CHR(LENGTH(SRC)+LENGTH(DEST))
     END
 END (*SCONCAT*) ;

 PROCEDURE SINSERT(*VAR SRC,DEST: STRING; DESTLENG,INSINX: INTEGER*);
   VAR ONRIGHT: INTEGER;
 BEGIN
   IF (INSINX > 0) AND (LENGTH(SRC) > 0) AND
       (LENGTH(SRC)+LENGTH(DEST) <= DESTLENG) THEN
     BEGIN
       ONRIGHT := LENGTH(DEST)-INSINX+1;
       IF ONRIGHT > 0 THEN
         BEGIN
           MOVERIGHT(DEST[INSINX],DEST[INSINX+LENGTH(SRC)],ONRIGHT);
           ONRIGHT := 0
         END;
       IF ONRIGHT = 0 THEN
         BEGIN
           MOVELEFT(SRC[1],DEST[INSINX],LENGTH(SRC));
           DEST[0] := CHR(LENGTH(DEST)+LENGTH(SRC))
         END
     END
 END (*SINSERT*) ;

 PROCEDURE SCOPY(*VAR SRC,DEST: STRING; SRCINX,COPYLENG: INTEGER*);
 BEGIN DEST := '';
   IF (SRCINX > 0) AND (COPYLENG > 0) AND
       (SRCINX+COPYLENG-1 <= LENGTH(SRC)) THEN
     BEGIN
       MOVELEFT(SRC[SRCINX],DEST[1],COPYLENG);
       DEST[0] := CHR(COPYLENG)
     END
 END (*SCOPY*) ;

 PROCEDURE SDELETE(*VAR DEST: STRING; DELINX,DELLENG: INTEGER*);
   VAR ONRIGHT: INTEGER;
 BEGIN
   IF (DELINX > 0) AND (DELLENG > 0) THEN
     BEGIN
       ONRIGHT := LENGTH(DEST)-DELINX-DELLENG+1;
       IF ONRIGHT = 0 THEN DEST[0] := CHR(DELINX-1)
       ELSE
         IF ONRIGHT > 0 THEN
           BEGIN
             MOVELEFT(DEST[DELINX+DELLENG],DEST[DELINX],ONRIGHT);
             DEST[0] := CHR(LENGTH(DEST)-DELLENG)
           END
     END
 END (*SDELETE*) ;

 FUNCTION SPOS(*VAR TARGET, SRC: STRING*);
 LABEL 1;
 VAR  TEMPLOC,DIST: INTEGER;
      FIRSTCH: CHAR;
      TEMP: STRING;
 BEGIN SPOS := 0;
   IF LENGTH(TARGET) > 0 THEN
     BEGIN
       FIRSTCH := TARGET[1];
       TEMPLOC := 1;
       DIST := LENGTH(SRC)-LENGTH(TARGET) + 1;
       TEMP[0] :=  TARGET[0];
       WHILE TEMPLOC <= DIST DO
         BEGIN
           TEMPLOC := TEMPLOC + SCAN(DIST-TEMPLOC,=FIRSTCH,SRC[TEMPLOC]) ;
											
           IF TEMPLOC>DIST THEN
              GOTO 1;
           MOVELEFT(SRC[TEMPLOC],TEMP[1],LENGTH(TARGET));
           IF TEMP=TARGET THEN
             BEGIN SPOS := TEMPLOC; GOTO 1 END;
           TEMPLOC := TEMPLOC+1
         END
     END;
 1:
 END (*SPOS*) ;

 (* MAIN DRIVER OF SYSTEM *)

 PROCEDURE COMMAND;
   VAR T: INTEGER;
 BEGIN STATE := HALTINIT;
   REPEAT
     RELEASE(EMPTYHEAP);
     WHILE UNITABLE[SYSCOM^.SYSUNIT].UVID <> SYVID DO
       BEGIN
         PL := 'Put in :';
         INSERT(SYVID,PL,8);
         PROMPT; T := 4000;
         REPEAT T := T-1
         UNTIL T = 0;
         IF FETCHDIR(SYSCOM^.SYSUNIT) THEN
       END;
     STATE := GETCMD(STATE);
     CASE STATE OF
       UPROGNOU,UPROGUOK,SYSPROG,
       COMPONLY,COMPANDGO,COMPDEBUG,
       LINKANDGO,LINKDEBUG:
         USERPROGRAM(NIL,NIL);
       DEBUGCALL:
         DEBUGGER
     END;
     IF STATE IN [UPROGNOU,UPROGUOK] THEN
       BEGIN
         FCLOSE(GFILES[0]^,CNORMAL);
         FCLOSE(GFILES[1]^,CLOCK)
       END;
     IF UNITBUSY(1) OR UNITBUSY(2) THEN
       UNITCLEAR(1)
   UNTIL STATE = HALTINIT
 END (*COMMAND*) ;

 BEGIN (*UCSD PASCAL SYSTEM*)
   EMPTYHEAP := NIL;
   INITIALIZE;
   REPEAT
     COMMAND;
     IF EMPTYHEAP <> NIL THEN
       INITIALIZE
   UNTIL EMPTYHEAP = NIL
 END (*PASCALSYSTEM*) .

{ +------------------------------------------------------------------+
  |                                                                  |
		|                     F     I     N     I     S                    |
		|                                                                  |
		+------------------------------------------------------------------+ }
		